Статьи по Delphi (022)…

Как преобразовать шестнадцатиричный цвет HTML в TColor.

Code: Unit colours; Interface. Uses. Windows, Sysutils, Graphics; Function ConvertHtmlHexToTColor(Color: string):TColor ; Function CheckHexForHash(col: string):string ; Implementation. Function ConvertHtmlHexToTColor(Color: string):TColor ; Var. RColor: TColor; Begin. Color := CheckHexForHash(Color); If (length(color) >= 6) then. Begin. {незабудьте, что TColor это bgr, а не rgb: поэтому необходимо изменить порядок}. Color := '$00' + copy(color,5,2) + copy(color,3,2) + copy(color,1,2); RColor := StrToInt(color); End; Result := rColor; End; // Просто проверяет первый сивол строки на наличие '#' и удаляет его, если он найден. Function CheckHexForHash(col: string):string ; Begin. If col[1] = '#' then. Col := StringReplace(col,'#','',[rfReplaceAll]); Result := col; End; End.

Мерцание формы.

Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?

Попробуйте этот код. Даже если некоторые компоненты имеют пару BeginUpdate / EndUpdate, то для таких компонентов, как TTreeView, интенсивное рисование может послужить причиной перемещения полосы прокрутки и появления других "барабашек". В таких ситуаций вместо дескриптора элемента управления используйте родительский дескриптор.

Code: Procedure BeginScreenUpdate(hwnd: THandle); Begin. If (hwnd = 0) then. Hwnd := Application.MainForm.Handle; SendMessage(hwnd, WM_SETREDRAW, 0, 0); End; Procedure EndScreenUpdate(hwnd: THandle; erase: Boolean); Begin. If (hwnd = 0) then. Hwnd := Application.MainForm.Handle; SendMessage(hwnd, WM_SETREDRAW, 1, 0); RedrawWindow(hwnd, nil, 0, DW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT); If (erase) then. Windows.InvalidateRect(hwnd, nil, True); End;

Качественно уменьшить изображение.

В Delphi изменять размеры изображения очень просто, используя CopyRect:

Code: Procedure TForm1.Button1Click(Sender: TObject); Begin. Form1.Canvas.Font.Size := 24; Form1.Canvas.TextOut(0, 0, 'Text'); Form1.Canvas.CopyRect(Bounds(0, 50, 25, 10), Form1.Canvas, Bounds(0, 0, 100, 40)); End;

Но этот способ не очень хорош для уменьшения не маленьких картинок – мелкие детали сливаются. Для частичного устранения этого недостатка при уменьшении изображения в четыре раза я беру средний цвет в каждом квадратике 4X4. К чему это приводит, посмотрите сами.

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. X, y: integer; I, j: integer; R, g, b: integer; Begin. Form1.Canvas.Font.Size := 24; Form1.Canvas.TextOut(0, 0, 'Text'); For y := 0 to 10 do. Begin. For x := 0 to 25 do. Begin. R := 0; For i := 0 to 3 do. For j := 0 to 3 do. R := r + GetRValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); R := round(r / 16); G := 0; For i := 0 to 3 do. For j := 0 to 3 do. G := g + GetGValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); G := round(g / 16); B := 0; For i := 0 to 3 do. For j := 0 to 3 do. B := b + GetBValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); B := round(b / 16); Form1.Canvas.Pixels[x,y+50] := RGB(r, g, b). End; Application.ProcessMessages; End; End;

©Drkb::03829.

Code: Unit ProjetoX_Screen; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, DBCtrls; Type. TFormScreen = class(TForm). ImgFundo: TImage; Procedure FormCreate(Sender: TObject); Public. MyRegion : HRGN; Function BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN; End; Var. FormScreen: TFormScreen; Implementation. {$R *.DFM}. Function TFormScreen.BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN; Const. ALLOC_UNIT = 100; Var. MemDC, DC: HDC; BitmapInfo: TBitmapInfo; Hbm32, holdBmp, holdMemBmp: HBitmap; Pbits32 : Pointer; Bm32 : BITMAP; MaxRects: DWORD; HData: HGLOBAL; PData: PRgnData; B, CR, CG, CB : Byte; P32: pByte; X, x0, y: integer; P: pLongInt; Pr: PRect; H: HRGN; Begin. Result := 0; If hBmp <> nil then. Begin. MemDC := CreateCompatibleDC(0); If MemDC <> 0 then. Begin. With BitmapInfo.bmiHeader do. Begin. BiSize := sizeof(TBitmapInfoHeader); BiWidth := hBmp.Width; BiHeight := hBmp.Height; BiPlanes := 1; BiBitCount := 32; BiCompression := BI_RGB; BiSizeImage := 0; BiXPelsPerMeter := 0; BiYPelsPerMeter := 0; BiClrUsed := 0; BiClrImportant := 0; End; Hbm32 := CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, pbits32,0, 0); If hbm32 <> 0 then. Begin. HoldMemBmp := SelectObject(MemDC, hbm32); GetObject(hbm32, SizeOf(bm32), @bm32); While (bm32.bmWidthBytes mod 4) > 0 do. Inc(bm32.bmWidthBytes); DC := CreateCompatibleDC(MemDC); HoldBmp := SelectObject(DC, hBmp.Handle); BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 0, 0, SRCCOPY); MaxRects := ALLOC_UNIT; HData := GlobalAlloc(GMEM_MOVEABLE, sizeof(TRgnDataHeader) + SizeOf(TRect) * maxRects); PData := GlobalLock(hData); PData^.rdh.dwSize := SizeOf(TRgnDataHeader); PData^.rdh.iType := RDH_RECTANGLES; PData^.rdh.nCount := 0; PData^.rdh.nRgnSize := 0; SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0); CR := GetRValue(ColorToRGB(TransColor)); CG := GetGValue(ColorToRGB(TransColor)); CB := GetBValue(ColorToRGB(TransColor)); P32 := bm32.bmBits; Inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes); For y := 0 to hBmp.Height-1 do. Begin. X := -1; While x+1 < hBmp.Width do. Begin. Inc(x); X0 := x; P := PLongInt(p32); Inc(PChar(p), x * SizeOf(LongInt)); While x < hBmp.Width do. Begin. B := GetBValue(p^); If (b = CR) then. Begin. B := GetGValue(p^); If (b = CG) then. Begin. B := GetRValue(p^); If (b = CB) then. Break; End; End; Inc(PChar(p), SizeOf(LongInt)); Inc(x); End; If x > x0 then. Begin. If pData^.rdh.nCount >= maxRects then. Begin. GlobalUnlock(hData); Inc(maxRects, ALLOC_UNIT); HData := GlobalReAlloc(hData, SizeOf(TRgnDataHeader) + SizeOf(TRect) * maxRects, GMEM_MOVEABLE); PData := GlobalLock(hData); Assert(pData <> NIL); End; Pr := @pData^.Buffer[pData^.rdh.nCount * SizeOf(TRect)]; SetRect(pr^, x0, y, x, y+1); If x0 < pData^.rdh.rcBound.Left then. PData^.rdh.rcBound.Left := x0; If y < pData^.rdh.rcBound.Top then. PData^.rdh.rcBound.Top := y; If x > pData^.rdh.rcBound.Right then. PData^.rdh.rcBound.Left := x; If y+1 > pData^.rdh.rcBound.Bottom then. PData^.rdh.rcBound.Bottom := y+1; Inc(pData^.rdh.nCount); If pData^.rdh.nCount = 2000 then. Begin. H := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) + (SizeOf(TRect) * maxRects), pData^); Assert(h <> 0); If Result <> 0 then. Begin. CombineRgn(Result, Result, h, RGN_OR); DeleteObject(h); End else. Result := h; PData^.rdh.nCount := 0; SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0); End; End; End; Dec(PChar(p32), bm32.bmWidthBytes); End; H := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) + (SizeOf(TRect) * maxRects), pData^); Assert(h <> 0); If Result <> 0 then. Begin. CombineRgn(Result, Result, h, RGN_OR); DeleteObject(h); End else. Result := h; GlobalFree(hData); SelectObject(DC, holdBmp); DeleteDC(DC); DeleteObject(SelectObject(MemDC, holdMemBmp)); End; End; DeleteDC(MemDC); End; End; Procedure TFormScreen.FormCreate(Sender: TObject); Begin. MyRegion := BitmapToRegion(imgFundo.Picture.Bitmap,imgFundo.Canvas.Pixels[0,0]); SetWindowRgn(Handle,MyRegion,True); End; Procedure TFormXXXXXX.FormCreate(Sender: TObject); Begin. FormScreen.MyRegion := FormScreen.BitmapToRegion(imgFundo.Picture.Bitmap, ImgFundo.Canvas.Pixels[0,0]); SetWindowRgn(Handle,FormScreen.MyRegion,True); End;

Плавно превратить один рисунок в другой.

Code: Procedure TForm1.Button1Click(Sender: TObject); Const. Count = 100; Var. I: integer; X, y: integer; Bm, bm1, bm2: TBitMap; P1, p2, p: PByteArray; C: integer; K: integer; Begin. Bm := TBitMap.Create; Bm1 := TBitMap.Create; Bm2 := TBitMap.Create; Bm1.LoadFromFile('Bitmap1.bmp'); Bm2.LoadFromFile('Bitmap2.bmp'); If bm1.Height < bm2.Height then. Begin. Bm.Height := bm1.Height; Bm2.Height := bm1.Height; End. Else. Begin. Bm.Height := bm2.Height; Bm1.Height := bm2.Height; End; If bm1.Width < bm2.Width then. Begin. Bm.Width := bm1.Width; Bm2.Width := bm1.Width; End. Else. Begin. Bm.Width := bm2.Width; Bm1.Width := bm2.Width; End; Bm.PixelFormat := pf24bit; Bm1.PixelFormat := pf24bit; Bm2.PixelFormat := pf24bit; Form1.Canvas.Draw(0, 0, bm1); For i := 1 to count - 1 do. Begin. For y := 0 to bm.Height - 1 do. Begin. P := bm.ScanLine[y]; P1 := bm1.ScanLine[y]; P2 := bm2.ScanLine[y]; For x := 0 to bm.Width * 3 - 1 do. P^[x] := round((p1^[x] * (count - i) + p2^[x] * i) / count); End; Form1.Canvas.Draw(0, 0, bm); Form1.Caption := IntToStr(round(i / count * 100)) + '%'; Application.ProcessMessages; If Application.Terminated then. Break; End; Form1.Canvas.Draw(0, 0, bm2); Form1.Caption := 'done'; Bm1.Destroy; bm2.Destroy; bm.Destroy; End;

Как получить картинки из MessageDlg?

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. Ic: TIcon; Begin. Ic := TIcon.Create; Ic.Handle := LoadIcon(0, IDI_APPLICATION); Form1.Canvas.Draw(1, 1, Ic); Ic.Handle := LoadIcon(0, IDI_ASTERISK); Form1.Canvas.Draw(32, 1, Ic); Ic.Handle := LoadIcon(0, IDI_EXCLAMATION); Form1.Canvas.Draw(64, 1, Ic); Ic.Handle := LoadIcon(0, IDI_QUESTION); Form1.Canvas.Draw(1, 32, Ic); Ic.Handle := LoadIcon(0, IDI_HAND); Form1.Canvas.Draw(32, 32, Ic); Ic.Handle := LoadIcon(0, IDI_WINLOGO); Form1.Canvas.Draw(64, 32, Ic); Ic.Destroy; End;

GDI - графика в Delphi.

Автор: Alistair Keys.

Жаргон GDI.

GDI расшифровывается как Graphics Device Interface, и представляет собой интерфейс, который Windows использует для рисования 2D графики. Также это самый медленный способ отображения графики из существующих, однако самый простой для понимания основ. Итак, для начала, поговорим об основных понятиях и терминах в GDI.

Начнём с того, что GDI обычно не используют для создания крутых графических эффектов, для этого есть DirectX, OpenGL, или любые графические библиотеки (такие как: DelphiX, FastLib, DIBUltra, Graphics32...). Однако, для создание простых эффектов с минимальными усилиями GDI вполне сгодится.

С GDI тесно связана ещё одна аббревиатура - DC ("Device Context" - контекст устройства). Это то, на чём мы рисуем, и в Delphi контекст устройства представлен как TCanvas. Идея контекста устройства заключается в том, что это универсальное устройство вывода, поэтому можно использовать одинаковые функции как для экрана, так и для принтера.

Все графические функции в Delphi являются надстройками над стандартными GDI функциями Windows. Позже мы поговорим об этих функциях.

А теперь самое время приступить к рассмотрению того, как устроен GDI. Ниже, в таблице, представлены некоторые важные классы:

Pen Используется для рисования простых линий. Обычно применяется для функции LineTo или при рисовании рамки для определённой фигуры (например для функции Rectangle).

Brush Кисть используется для заполнения области определённым цветом. Применяется в функциях Rectangle, FillRect или FloodFill.

Font Используется для задания шрифта, которым будет нарисован текст. Можно указать имя шрифта, размер и т.д.

Region Позволяет задать регион (замкнутое пространство). Регионом может быть круг, квадрат или произвольная фигура. Позволяет так же делать дырки в фигурах.

Однако, пора переходить от слов к делу, а именно, начать рисовать линии и фигуры.

Рисование линий.

Сперва необходимо чётко уяснить, что координата (0,0) это верхний левый угол экрана. То есть значения по оси y увеличиваются вниз экрана. Соответственно, координата (0, 50) означает, что мы просто отступили на 50 пикселей от верха экрана.

Самое главное, что надо знать при рисовании линий и фигур, это различие между пером (Pen) и кистью (Brush). Всё очень просто: перо (Pen) используется при рисовании линий или рамок, а кисть (Brush) для заполнения фигуры.

Ниже приведены две функции, которые используются для рисования линий и обе принадлежат TCanvas:

MoveTo Перемещает точку начала рисования линии в указанные координаты x и y Canvas.MoveTo(50, 100);

LineTo Рисует линию начиная с текущей позиции (см. MoveTo) до указанных координат x и y. Canvas.LineTo(50, 100);

Эффект перемещения точки начала рисования линии так же достигается при помощи установки своства PenPos в канвасе... например, "Canvas.PenPos.x := 20;", "Canvas.PenPos.y := 50", или "Canvas.PenPos := Point(20,50);".

По умолчанию, точка начала рисования установлена в (0,0), то есть, если сразу вызвать "Canvas.LineTo(100,100);" то будет нарисована линия из точки (0,0) в точку (100, 100). Точка начала рисования автоматически переместится в (100, 100), то есть, если выполнить команду "Canvas.LineTo(200, 100);", то следующая линия будет нарисована из точки (100, 100) в (200, 100). Поэтому, если мы хотим рисовать линии несоединённые друг с другом, то придётся воспользоваться методом MoveTo.

Линия, нарисованная при помощи LineTo использует текущее перо канваса (типа TPen). Основные свойства пера, это ширина - "Canvas.Pen.Width := 4;" (при помощи которого можно задавать различную ширину линий), и цвет "Canvas.Pen.Color := clLime;".

Взглянем на простой пример беспорядочного рисования разноцветных линий:

Code: Procedure TForm1.FormCreate(Sender: TObject); Begin. // инициализируем генератор. // случайных чисел. Randomize; End; Const. NUM_LINES = 2000; Procedure TForm1.DrawLines; Var. I: Integer; Begin. For i := 0 to NUM_LINES - 1 do. Begin. Canvas.Pen.Color := RGB(Random(256), Random(256), Random(256)); Canvas.LineTo. (Random(ClientWidth), Random(ClientHeight)); End; End;

Как изменить шрифт hint?

Code: { When the application displays a Help Hint, It creates an instance of HintWindowClass to represent. The window used for displaying the hint. Applications can customize this window by creating a. Descendant of THintWindow and assigning it to the. HintWindowClass variable at application startup. } Type. TMyHintWindow = class(THintWindow). Constructor Create(AOwner: TComponent); override; End; Implementation. {....} Constructor TMyHintWindow.Create(AOwner: TComponent); Begin. Inherited Create(AOwner); With Canvas.Font do. Begin. Name := 'Arial'; Size := Size + 5; Style := [fsBold]; End; End; Procedure TForm2.FormCreate(Sender: TObject); Begin. HintWindowClass := TMyHintWindow; Application.ShowHint := False; Application.ShowHint := True; End;

Рисование без мерцания.

Автор: Mike Scott.

...вот я и удивляюсь - почему я получаю мерцание, если я вызываю Repaint или Refresh, а не метод OnPaint напрямую? Или это просто "вариация на тему"?

Имеются две фазы обновления окна. В первой фазе, при выводе окна, Windows посылает ему сообщение WM_ERASEBKGND, сообщающее о необходимости стирания фона перед процедурой рисования. Затем посылается сообщение WM_PAINT, служащее сигналом для закрашивания "переднего плана".

Тем не менее, вы можете пропустить первую фазу, которая вызывает мерцание, одним из двух способов: первый способ заключается в том, что вы форсируете обновление сами, с помощью вызова функции Windows API InvalidateRect. На входе он получает дескриптор окна, указатель на закрашиваемую область - передаем NIL, если вы хотите отрисовать всю область окна - и третий параметр, сообщающий о необходимости очистки фона. Вот как раз последний параметр и должен содержать значение FALSE, если вы сами будете в методе Paint полностью отрисовывать всю область:

InvalidateRect( Handle, NIL, FALSE ) ;

Handle должен быть дескриптором формы или элемента управления.

Описав первый способ, я скажу, что существует другое подходящее решение - использовать функциональность VCL. Вы можете указать VCL не стирать фон, добавляя [ csOpaque ] к значению свойства ControlStyle, как показано ниже:

ControlStyle := ControlStyle + [ csOpaque ] ;

Это ограничивает заполнение заднего фона, но вы все еще можете видеть процесс "наполнения" области изображением, т.е. процесс рисования. В этом случае вы можете отделаться от эффекта мельтешения, рисуя на TBitmap и выводя его затем на экран командой CopyRect.

Если вы хотите углубиться в тему дальше, то я отошлю вас к моей статье "Optimizing Display Updates in Delphi" (Оптимизация обновления экрана в Delphi), опубликованной в первом выпуске журнала "Delphi magazine".

©Drkb::03729.

Взято с http://delphiworld.narod.ru.

Как построить строку подключения.

Code: Function BuildConnectionString(Database, Server, Login, Password:string):Widestring; {©Drkb v.3(2007): www.drkb.ru, ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}. Begin. If Password<>'' then Password:=';Password='+Password+';Persist Security Info=True' else Password:=';Persist Security Info=False'; Result:=Format('Provider=SQLOLEDB.1%s;User ID=%s;Initial Catalog=%s;Data Source=%s', [Password, Login, Database, Server]); End;

Рисование графов.

...вы могли бы использовать объект TCanvas, чем рисовать самому. В вашем случае сгодится компонент TImage, он имеет bitmap и свойство canvas, на котором очень удобно рисовать.

Пример: (Создайте новую форму, добавьте к ней Image и Button. Добавьте следующий код к обработчику события нажатия кнопки).

Code: Var. X, l: Integer; Y, a: Double; Begin. Image1.Picture.Bitmap := TBitmap.Create; Image1.Picture.Bitmap.Width := Image1.Width; Image1.Picture.Bitmap.Height := Image1.Height; {Эти три строчки могут быть. Размещены в обработчике Form1.Create}. L := Image1.Picture.Bitmap.Width; For x := 0 to l do. Begin. A := (x / l) * 2 * Pi; {Преобразуем позицию по оси X к углу между 0 & 2Pi}. Y := Sin(a); {Ваша функция должна находиться здесь}. Y := y * (Image1.Picture.Bitmap.Height / 2); {Масштабируем по оси Y}. Y := y * -1; {Инвертируем Y, верх экрана это 0 !}. Y := y + (Image1.Picture.Bitmap.Height / 2); {Добавляем компенсацию для среднего 0}. Image1.Picture.Bitmap.Canvas.Pixels[Trunc(x), Trunc(y)] := clBlack; End; End;

Рисование КРИВЫХ в Delphi.

Автор: Dmitry Streblechenko.

У кого-нибудь есть исходный код или какая-либо информация для рисования кривых Безье? Я должен использовать их в своем компоненте.

Я делал это недавно; мне было лениво разбираться с тем, как рисовать кривые Безье с помощью Win API, поэтому я использовал функцию Polyline().

Примечание: для координатных точек я использовал реальные величины типа floating (я применял некоторый тип виртуального экрана), округляя их до целого.

Code: PBezierPoint = ^TBezierPoint; TBezierPoint = record. X, Y: double; // основной узел. Xl, Yl: double; // левая контрольная точка. Xr, Yr: double; // правая контрольная точка. End; // P1 и P2 - две точки TBezierPoint, расположенные между 0 и 1: // когда t=0 X=P1.X, Y=P1.Y; когда t=1 X=P2.X, Y=P2.Y; Procedure BezierValue(P1, P2: TBezierPoint; t: double; var X, Y: double); Var. T_sq, t_cb, r1, r2, r3, r4: double; Begin. T_sq := t * t; T_cb := t * t_sq; R1 := (1 - 3 * t + 3 * t_sq - t_cb) * P1.X; R2 := (3 * t - 6 * t_sq + 3 * t_cb) * P1.Xr; R3 := (3 * t_sq - 3 * t_cb) * P2.Xl; R4 := (t_cb) * P2.X; X := r1 + r2 + r3 + r4; R1 := (1 - 3 * t + 3 * t_sq - t_cb) * P1.Y; R2 := (3 * t - 6 * t_sq + 3 * t_cb) * P1.Yr; R3 := (3 * t_sq - 3 * t_cb) * P2.Yl; R4 := (t_cb) * P2.Y; Y := r1 + r2 + r3 + r4; End;

Рисование фрактальных графов.

Автор: Михаил Марковский.

...Очередная нетленка, которую я предлагаю Вам, написана мной самостоятельно (идею и примеры, реализованные в программе, я нашел в апрельском номере журнала "Химия и жизнь" за 1995 год). Теоретически она производит трансляцию L-систем с выводом образовавшихся фрактальных графов, а практически рисует кусты и деревья. Вроде бесполезно, но очень красиво. Эта программа написана для TP7, хотя легко переносится на Delphi (как то я уже переводил ее, но модуль бесследно исчез). Буду надеяться, что она придется Вам по душе.

Code: Uses graph, crt; Const. GrafType = 1; {1..3}. Type. PointPtr = ^Point; Point = record. X, Y: Word; Angle: Real; Next: PointPtr. End; GrfLine = array[0..5000] of. Byte; ChangeType = array[1..30] of. Record. Mean: Char; NewString: string. End; Var. K, T, Dx, Dy, StepLength, GrafLength: Word; GrDriver, Xt: Integer; GrMode: Integer; ErrCode: Integer; CurPosition: Point; Descript: GrfLine; StartLine: string absolute Descript; ChangeNumber, Generation: Byte; Changes: ChangeType; AngleStep: Real; Mem: Pointer; Procedure Replace(var Stroka: GrfLine; OldChar: Char; Repl: string); Var. I, J: Word; Begin. If (GrafLength = 0) or (Length(Repl) = 0) then. Exit; I := 1; While I <= GrafLength do. Begin. If Chr(Stroka[I]) = OldChar then. Begin. For J := GrafLength downto I + 1 do. Stroka[J + Length(Repl) - 1] := Stroka[J]; For J := 1 to Length(Repl) do. Stroka[I + J - 1] := Ord(Repl[J]); I := I + J; GrafLength := GrafLength + Length(Repl) - 1; Continue. End; I := I + 1. End. End; Procedure PushCoord(var Ptr: PointPtr; C: Point); Var. P: PointPtr; Begin. New(P); P^.X := C.X; P^.Y := C.Y; P^.Angle := C.Angle; P^.Next := Ptr; Ptr := P. End; Procedure PopCoord(var Ptr: PointPtr; Var Res: Point); Begin. If Ptr <> nil then. Begin. Res.X := Ptr^.X; Res.Y := Ptr^.Y; Res.Angle := Ptr^.Angle; Ptr := Ptr^.Next. End. End; Procedure FindGrafCoord(var Dx, Dy: Word; Angle: Real; StepLength: Word); Begin. Dx := Round(Sin(Angle) * StepLength * GetMaxX / GetMaxY); Dy := Round(-Cos(Angle) * StepLength); End; Procedure NewAngle(Way: ShortInt; Var Angle: Real; AngleStep: Real); Begin. If Way >= 0 then. Angle := Angle + AngleStep. Else. Angle := Angle - AngleStep; If Angle >= 4 * Pi then. Angle := Angle - 4 * Pi; If Angle < 0 then. Angle := 4 * Pi + Angle. End; Procedure Rost(var Descr: GrfLine; Cn: Byte; Ch: ChangeType); Var. I: Byte; Begin. For I := 1 to Cn do. Replace(Descr, Ch[I].Mean, Ch[I].NewString); End; Procedure Init1; Begin. AngleStep := Pi / 8; StepLength := 7; Generation := 4; ChangeNumber := 1; CurPosition.Next := nil; StartLine := 'F'; GrafLength := Length(StartLine); With Changes[1] do. Begin. Mean := 'F'; NewString := 'FF+[+F-F-F]-[-F+F+F]' End; End; Procedure Init2; Begin. AngleStep := Pi / 4; StepLength := 3; Generation := 5; ChangeNumber := 2; CurPosition.Next := nil; StartLine := 'G'; GrafLength := Length(StartLine); With Changes[1] do. Begin. Mean := 'G'; NewString := 'GFX[+G][-G]' End; With Changes[2] do. Begin. Mean := 'X'; NewString := 'X[-FFF][+FFF]FX' End; End; Procedure Init3; Begin. AngleStep := Pi / 10; StepLength := 9; Generation := 5; ChangeNumber := 5; CurPosition.Next := nil; StartLine := 'SLFF'; GrafLength := Length(StartLine); With Changes[1] do. Begin. Mean := 'S'; NewString := '[+++G][---G]TS' End; With Changes[2] do. Begin. Mean := 'G'; NewString := '+H[-G]L' End; With Changes[3] do. Begin. Mean := 'H'; NewString := '-G[+H]L' End; With Changes[4] do. Begin. Mean := 'T'; NewString := 'TL' End; With Changes[5] do. Begin. Mean := 'L'; NewString := '[-FFF][+FFF]F' End; End; Begin. Case GrafType of. 1: Init1; 2: Init2; 3: Init3; Else. End; GrDriver := detect; InitGraph(grDriver, grMode, ''); ErrCode := GraphResult; If ErrCode <> grOk then. Begin. WriteLn('Graphics error:', GraphErrorMsg(ErrCode)); Halt(1). End; With CurPosition do. Begin. X := GetMaxX div 2; Y := GetMaxY; Angle := 0; MoveTo(X, Y). End; SetColor(white); For K := 1 to Generation do. Begin. Rost(Descript, ChangeNumber, Changes); Mark(Mem); For T := 1 to GrafLength do. Begin. Case Chr(Descript[T]) of. 'F': Begin. FindGrafCoord(Dx, Dy, CurPosition.Angle, StepLength); With CurPosition do. Begin. Xt := X + Dx; If Xt < 0 then. X := 0. Else. X := Xt; If X > GetMaxX then. X := GetMaxX; Xt := Y + Dy; If Xt < 0 then. Y := 0. Else. Y := Xt; If Y > GetMaxY then. Y := GetMaxY; LineTo(X, Y). End. End; 'f': Begin. FindGrafCoord(Dx, Dy, CurPosition.Angle, StepLength); With CurPosition do. Begin. Xt := X + Dx; If Xt < 0 then. X := 0. Else. X := Xt; If X > GetMaxX then. X := GetMaxX; Xt := Y + Dy; If Xt < 0 then. Y := 0. Else. Y := Xt; If Y > GetMaxY then. Y := GetMaxY; MoveTo(X, Y). End. End; '+': NewAngle(1, CurPosition.Angle, AngleStep); '-': NewAngle(-1, CurPosition.Angle, AngleStep); 'I': NewAngle(1, CurPosition.Angle, 2 * Pi); '[': PushCoord(CurPosition.Next, CurPosition); ']': Begin. PopCoord(CurPosition.Next, CurPosition); With CurPosition do. MoveTo(X, Y). End. End. End; Dispose(Mem); Delay(1000). End; Repeat. Until KeyPressed; CloseGraph. End.

ScreenMate.

Многие из вас знакомы с этим термином. Так характеризуют программы, которые выводят на экран спрайтового персонажа, не создавая при этом окна. Я очень давно искал данный пример в сети, и теперь решил вас порадовать. Программа состоит из нескольких узлов, кои будут приведены ниже...

P.s К сожалению вам надо позаботиться о кадрах анимации этого персонажа самим т.к рисунки я послать немогу...

Code: {*******************************************************} { } { Delphi VCL Extensions (RX) }. { } { Copyright (c) 1995, 1996 AO ROSNO }. { Copyright (c) 1997, 1998 Master-Bank }. { } {*******************************************************} Unit Animate; Interface. {$I RX.INC}. Uses Messages, {$IFDEF WIN32}Windows, {$ELSE}WinTypes, WinProcs, {$ENDIF}. SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Menus, ExtCtrls; Type. TGlyphOrientation = (goHorizontal, goVertical); { TRxImageControl }. TRxImageControl = class(TGraphicControl). Private. FDrawing: Boolean; Protected. FGraphic: TGraphic; Function DoPaletteChange: Boolean; Procedure DoPaintImage; virtual; abstract; Procedure PaintDesignRect; Procedure PaintImage; Procedure PictureChanged; Public. Constructor Create(AOwner: TComponent); override; End; { TAnimatedImage }. TAnimatedImage = class(TRxImageControl). Private. { Private declarations }. FActive: Boolean; FAutoSize: Boolean; FGlyph: TBitmap; FImageWidth: Integer; FImageHeight: Integer; FInactiveGlyph: Integer; FOrientation: TGlyphOrientation; FTimer: TTimer; FNumGlyphs: Integer; FGlyphNum: Integer; FStretch: Boolean; FTransparentColor: TColor; FOpaque: Boolean; FTimerRepaint: Boolean; FOnFrameChanged: TNotifyEvent; FOnStart: TNotifyEvent; FOnStop: TNotifyEvent; Procedure DefineBitmapSize; Procedure ResetImageBounds; Procedure AdjustBounds; Function GetInterval: Cardinal; Procedure SetAutoSize(Value: Boolean); Procedure SetInterval(Value: Cardinal); Procedure SetActive(Value: Boolean); Procedure SetOrientation(Value: TGlyphOrientation); Procedure SetGlyph(Value: TBitmap); Procedure SetGlyphNum(Value: Integer); Procedure SetInactiveGlyph(Value: Integer); Procedure SetNumGlyphs(Value: Integer); Procedure SetStretch(Value: Boolean); Procedure SetTransparentColor(Value: TColor); Procedure SetOpaque(Value: Boolean); Procedure ImageChanged(Sender: TObject); Procedure UpdateInactive; Procedure TimerExpired(Sender: TObject); Function TransparentStored: Boolean; Procedure WMSize(var Message: TWMSize); message WM_SIZE; Protected. { Protected declarations }. Function GetPalette: HPALETTE; override; Procedure Loaded; override; Procedure Paint; override; Procedure DoPaintImage; override; Procedure FrameChanged; dynamic; Procedure Start; dynamic; Procedure Stop; dynamic; Public. { Public declarations }. Constructor Create(AOwner: TComponent); override; Destructor Destroy; override; Procedure DoPaintImageOn(Mycanvas: Tcanvas; x, y: integer); Virtual; Published. { Published declarations }. Property Active: Boolean read FActive write SetActive default. False; Property Align; Property AutoSize: Boolean read FAutoSize write SetAutoSize. Default True; Property Orientation: TGlyphOrientation read FOrientation write. SetOrientation. Default goHorizontal; Property Glyph: TBitmap read FGlyph write SetGlyph; Property GlyphNum: Integer read FGlyphNum write SetGlyphNum. Default 0; Property Interval: Cardinal read GetInterval write SetInterval. Default 100; Property NumGlyphs: Integer read FNumGlyphs write SetNumGlyphs. Default 1; Property InactiveGlyph: Integer read FInactiveGlyph write. SetInactiveGlyph default -1; Property TransparentColor: TColor read FTransparentColor write. SetTransparentColor. Stored TransparentStored; Property Opaque: Boolean read FOpaque write SetOpaque default. False; Property Color; Property Cursor; Property DragCursor; Property DragMode; Property ParentColor default True; Property ParentShowHint; Property PopupMenu; Property ShowHint; Property Stretch: Boolean read FStretch write SetStretch default. True; Property Visible; Property OnClick; Property OnDblClick; Property OnMouseMove; Property OnMouseDown; Property OnMouseUp; Property OnDragOver; Property OnDragDrop; Property OnEndDrag; {$IFDEF WIN32}. Property OnStartDrag; {$ENDIF}. Property OnFrameChanged: TNotifyEvent read FOnFrameChanged write. FOnFrameChanged; Property OnStart: TNotifyEvent read FOnStart write FOnStart; Property OnStop: TNotifyEvent read FOnStop write FOnStop; End; Implementation. Uses RxConst, VCLUtils; { TRxImageControl }. Constructor TRxImageControl.Create(AOwner: TComponent); Begin. Inherited Create(AOwner); ControlStyle := [csClickEvents, csCaptureMouse, csOpaque, {$IFDEF WIN32}csReplicatable, {$ENDIF}csDoubleClicks]; Height := 105; Width := 105; ParentColor := True; End; Procedure TRxImageControl.PaintImage; Var. Save: Boolean; Begin. Save := FDrawing; FDrawing := True; Try. DoPaintImage; Finally. FDrawing := Save; End; End; Procedure TRxImageControl.PaintDesignRect; Begin. If csDesigning in ComponentState then. With Canvas do. Begin. Pen.Style := psDash; Brush.Style := bsClear; Rectangle(0, 0, Width, Height); End; End; Function TRxImageControl.DoPaletteChange: Boolean; Var. ParentForm: TCustomForm; Tmp: TGraphic; Begin. Result := False; Tmp := FGraphic; If Visible and (not (csLoading in ComponentState)) and (Tmp <> Nil). {$IFDEF RX_D3} and (Tmp.PaletteModified){$ENDIF} then. Begin. If (GetPalette <> 0) then. Begin. ParentForm := GetParentForm(Self); If Assigned(ParentForm) and ParentForm.Active and. Parentform.HandleAllocated then. Begin. If FDrawing then. ParentForm.Perform(WM_QUERYNEWPALETTE, 0, 0). Else. PostMessage(ParentForm.Handle, WM_QUERYNEWPALETTE, 0, 0); Result := True; {$IFDEF RX_D3}. Tmp.PaletteModified := False; {$ENDIF}. End; End. {$IFDEF RX_D3}. Else. Begin. Tmp.PaletteModified := False; End; {$ENDIF}. End; End; Procedure TRxImageControl.PictureChanged; Begin. If (FGraphic <> nil) then. If DoPaletteChange and FDrawing then. Update; If not FDrawing then. Invalidate; End; { TAnimatedImage }. Constructor TAnimatedImage.Create(AOwner: TComponent); Begin. Inherited Create(AOwner); FTimer := TTimer.Create(Self); Interval := 100; FGlyph := TBitmap.Create; FGraphic := FGlyph; FGlyph.OnChange := ImageChanged; FGlyphNum := 0; FNumGlyphs := 1; FInactiveGlyph := -1; FTransparentColor := clNone; FOrientation := goHorizontal; FAutoSize := True; FStretch := True; Width := 32; Height := 32; End; Destructor TAnimatedImage.Destroy; Begin. FOnFrameChanged := nil; FOnStart := nil; FOnStop := nil; FGlyph.OnChange := nil; Active := False; FGlyph.Free; Inherited Destroy; End; Procedure TAnimatedImage.Loaded; Begin. Inherited Loaded; ResetImageBounds; UpdateInactive; End; Function TAnimatedImage.GetPalette: HPALETTE; Begin. Result := 0; If not FGlyph.Empty then. Result := FGlyph.Palette; End; Procedure TAnimatedImage.ImageChanged(Sender: TObject); Begin. FTransparentColor := FGlyph.TransparentColor and not PaletteMask; DefineBitmapSize; AdjustBounds; PictureChanged; End; Procedure TAnimatedImage.UpdateInactive; Begin. If (not Active) and (FInactiveGlyph >= 0) and. (FInactiveGlyph < FNumGlyphs) and (FGlyphNum <> FInactiveGlyph) then. Begin. FGlyphNum := FInactiveGlyph; End; End; Function TAnimatedImage.TransparentStored: Boolean; Begin. Result := (FGlyph.Empty and (FTransparentColor <> clNone)) or. ((FGlyph.TransparentColor and not PaletteMask) <> FTransparentColor); End; Procedure TAnimatedImage.SetOpaque(Value: Boolean); Begin. If Value <> FOpaque then. Begin. FOpaque := Value; PictureChanged; End; End; Procedure TAnimatedImage.SetTransparentColor(Value: TColor); Begin. If Value <> TransparentColor then. Begin. FTransparentColor := Value; PictureChanged; End; End; Procedure TAnimatedImage.SetOrientation(Value: TGlyphOrientation); Begin. If FOrientation <> Value then. Begin. FOrientation := Value; DefineBitmapSize; AdjustBounds; Invalidate; End; End; Procedure TAnimatedImage.SetGlyph(Value: TBitmap); Begin. FGlyph.Assign(Value); End; Procedure TAnimatedImage.SetStretch(Value: Boolean); Begin. If Value <> FStretch then. Begin. FStretch := Value; PictureChanged; If Active then. Repaint; End; End; Procedure TAnimatedImage.SetGlyphNum(Value: Integer); Begin. If Value <> FGlyphNum then. Begin. If (Value < FNumGlyphs) and (Value >= 0) then. Begin. FGlyphNum := Value; UpdateInactive; FrameChanged; PictureChanged; End; End; End; Procedure TAnimatedImage.SetInactiveGlyph(Value: Integer); Begin. If Value < 0 then. Value := -1; If Value <> FInactiveGlyph then. Begin. If (Value < FNumGlyphs) or (csLoading in ComponentState) then. Begin. FInactiveGlyph := Value; UpdateInactive; FrameChanged; PictureChanged; End; End; End; Procedure TAnimatedImage.SetNumGlyphs(Value: Integer); Begin. FNumGlyphs := Value; If FInactiveGlyph >= FNumGlyphs then. Begin. FInactiveGlyph := -1; FGlyphNum := 0; End. Else. UpdateInactive; FrameChanged; ResetImageBounds; AdjustBounds; PictureChanged; End; Procedure TAnimatedImage.DefineBitmapSize; Begin. FNumGlyphs := 1; FGlyphNum := 0; FImageWidth := 0; FImageHeight := 0; If (FOrientation = goHorizontal) and (FGlyph.Height > 0) and. (FGlyph.Width mod FGlyph.Height = 0) then. FNumGlyphs := FGlyph.Width div FGlyph.Height. Else if (FOrientation = goVertical) and (FGlyph.Width > 0) and. (FGlyph.Height mod FGlyph.Width = 0) then. FNumGlyphs := FGlyph.Height div FGlyph.Width; ResetImageBounds; End; Procedure TAnimatedImage.ResetImageBounds; Begin. If FNumGlyphs < 1 then. FNumGlyphs := 1; If FOrientation = goHorizontal then. Begin. FImageHeight := FGlyph.Height; FImageWidth := FGlyph.Width div FNumGlyphs; End. Else {if Orientation = goVertical then}. Begin. FImageWidth := FGlyph.Width; FImageHeight := FGlyph.Height div FNumGlyphs; End; End; Procedure TAnimatedImage.AdjustBounds; Begin. If not (csReading in ComponentState) then. Begin. If FAutoSize and (FImageWidth > 0) and (FImageHeight > 0) then. SetBounds(Left, Top, FImageWidth, FImageHeight); End; End; Type. TParentControl = class(TWinControl);

Как запустить текущий ScreenSaver.

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

©Drkb::02378.

Взято с http://delphiworld.narod.ru.

Сначала мы проверяем, установлен ли Screen Saver, если нет - возвращаемся с отрицательным ответом, в противном случае - запускаем его и возвращаем true.

Code: Function RunScreenSaver: bool; Var. B: boolean; Begin. Result := false; If SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @b, 0) <> true then. Exit; If not b then. Exit; PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0); Result := true; End;

©Drkb::02379.

Http://delphiworld.narod.ru/

DelphiWorld 6.0.

Как сделать графический hint?

Code: {********************************************************* With the following Code you can simply create custom hints. You just have to change the procedur "Paint". *********************************************************} Type. TGraphicHintWindow = class(THintWindow). Constructor Create(AOwner: TComponent); override; Private. FActivating: Boolean; Public. Procedure ActivateHint(Rect: TRect; const AHint: string); override; Protected. Procedure Paint; override; Published. Property Caption; End; {...} Constructor TGraphicHintWindow.Create(AOwner: TComponent); Begin. Inherited Create(AOwner); { Here you can set custom Font Properties: } With Canvas.Font do. Begin. Name := 'Arial'; Style := Style + [fsBold]; Color := clBlack; End; End; Procedure TGraphicHintWindow.Paint; Var. R: TRect; Bmp: TBitmap; Begin. R := ClientRect; Inc(R.Left, 2); Inc(R.Top, 2); {******************************************************* The folowing Code ist an example how to create a custom. Hint Object. : } Bmp := TBitmap.Create; Bmp.LoadfromFile('D:\hint.bmp'); With Canvas do. Begin. Brush.Style := bsSolid; Brush.Color := clsilver; Pen.Color := clgray; Rectangle(0, 0, 18, R.Bottom + 1); Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp); End; Bmp.Free; //Beliebige HintFarbe. //custom Hint Color. Color := clWhite; Canvas.Brush.Style := bsClear; Canvas.TextOut(20, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption); {********************************************************} End; Procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string); Begin. FActivating := True; Try. Caption := AHint; //Нцhе des Hints setzen setzen. //Set the "Height" Property of the Hint. Inc(Rect.Bottom, 14); //Breite des Hints setzen. //Set the "Width" Property of the Hint. Rect.Right := Rect.Right + 20; UpdateBoundsRect(Rect); If Rect.Top + Height > Screen.DesktopHeight then. Rect.Top := Screen.DesktopHeight - Height; If Rect.Left + Width > Screen.DesktopWidth then. Rect.Left := Screen.DesktopWidth - Width; If Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft; If Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop; SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height, SWP_SHOWWINDOW or SWP_NOACTIVATE); Invalidate; Finally. FActivating := False; End; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. HintWindowClass := TGraphicHintWindow; Application.ShowHint := False; Application.ShowHint := True; End;

Как использовать файлы справки?

Code: { First we need to tell the Application object the name. Of the Help file and where to locate it. }. Application.HelpFile := ExtractFilePath(Application.ExeName) + 'YourHelpFile.hlp'; { To Show a help file's content tab: }. Application.HelpCommand(HELP_CONTENTS, 0); { To display a specific topic of your help file: }. Application.HelpJump('TApplication_HelpJump');

Получаем имена ODBC-источников.

Code: Uses Registry; Procedure TForm1.GetDataSourceNames(System: Boolean); Var. Reg: TRegistry; Begin. ListBox1.Items.Clear; Reg := TRegistry.Create; Try. If System then. Reg.RootKey := HKEY_LOCAL_MACHINE. Else. Reg.RootKey := HKEY_CURRENT_USER; If reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources', False) then. Begin. Reg.GetValueNames(ListBox1.Items); End; Finally. Reg.CloseKey; FreeAndNil(reg); End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. //Системные DSNs. GetDataSourceNames(True); //Пользовательские DSNs. GetDataSourceNames(False); End;

Сглаживание (anti-aliasing).

Code: {The parameter "percent" needs an integer between 0 and 100 (include zero and 100). If "Percent" is 0, there will be no effect. If it's 100 there will be the strongest effect.}. Procedure Antialising(C: TCanvas; Rect: TRect; Percent: Integer); Var. L, p: Integer; R, G, B: Integer; R1, R2, G1, G2, B1, B2: Byte; Begin. With c do. Begin. Brush.Style := bsclear; Lineto(200, 100); Moveto(50, 150); Ellipse(50, 150, 200, 30); For l := Rect.Top to Rect.Bottom do. Begin. For p := Rect.Left to Rect.Right do. Begin. R1 := GetRValue(Pixels[p, l]); G1 := GetGValue(Pixels[p, l]); B1 := GetBValue(Pixels[p, l]); //Pixel links. //Pixel left. R2 := GetRValue(Pixels[p - 1, l]); G2 := GetGValue(Pixels[p - 1, l]); B2 := GetBValue(Pixels[p - 1, l]); If (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then. Begin. R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p - 1, l] := RGB(R, G, B); End; //Pixel rechts. //Pixel right. R2 := GetRValue(Pixels[p + 1, l]); G2 := GetGValue(Pixels[p + 1, l]); B2 := GetBValue(Pixels[p + 1, l]); If (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then. Begin. R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p + 1, l] := RGB(R, G, B); End; //Pixel oben. //Pixel up. R2 := GetRValue(Pixels[p, l - 1]); G2 := GetGValue(Pixels[p, l - 1]); B2 := GetBValue(Pixels[p, l - 1]); If (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then. Begin. R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p, l - 1] := RGB(R, G, B); End; //Pixel unten. //Pixel down. R2 := GetRValue(Pixels[p, l + 1]); G2 := GetGValue(Pixels[p, l + 1]); B2 := GetBValue(Pixels[p, l + 1]); If (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then. Begin. R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p, l + 1] := RGB(R, G, B); End; End; End; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Antialising(Image1.Canvas, Image1.Canvas.ClipRect, 100); End;

BMP ---> RTF.

Code: Function BitmapToRTF(pict: TBitmap): string; Var. Bi, bb, rtf: string; Bis, bbs: Cardinal; Achar: ShortString; Hexpict: string; I: Integer; Begin. GetDIBSizes(pict.Handle, bis, bbs); SetLength(bi, bis); SetLength(bb, bbs); GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^); Rtf := '{\rtf1 {\pict\dibitmap0 '; SetLength(hexpict, (Length(bb) + Length(bi)) * 2); I := 2; For bis := 1 to Length(bi) do. Begin. Achar := IntToHex(Integer(bi[bis]), 2); Hexpict[I - 1] := achar[1]; Hexpict[I] := achar[2]; Inc(I, 2); End; For bbs := 1 to Length(bb) do. Begin. Achar := IntToHex(Integer(bb[bbs]), 2); Hexpict[I - 1] := achar[1]; Hexpict[I] := achar[2]; Inc(I, 2); End; Rtf := rtf + hexpict + ' }}'; Result := rtf; End;

Как получить более светлый или более тёмный цвет?

Code: { Here's some function that returns the lighter or darker color of a TColor. You can use it, for example, to design a bevel or something like that. } {=======================================} Function Min(a, b: Longint): Longint; Begin. If a > b then Result := b. Else. Result := a; End; Function Max(a, b: Longint): Longint; Begin. If a > b then Result := a. Else. Result := b; End; {=======================================} Function GetHighlightColor(BaseColor: TColor): TColor; Begin. Result := RGB(Min(GetRValue(ColorToRGB(BaseColor)) + 64, 255), Min(GetGValue(ColorToRGB(BaseColor)) + 64, 255), Min(GetBValue(ColorToRGB(BaseColor)) + 64, 255)); End; Function GetShadowColor(BaseColor: TColor): TColor; Begin. Result := RGB(Max(GetRValue(ColorToRGB(BaseColor)) - 64, 0), Max(GetGValue(ColorToRGB(BaseColor)) - 64, 0), Max(GetBValue(ColorToRGB(BaseColor)) - 64, 0)); End;

Как получить эффект тени для hint?

Code: Type. TXPHintWindow = class(THintWindow). Protected. Procedure CreateParams(var Params: TCreateParams); override; Procedure WMNCPaint(var msg: TMessage); message WM_NCPAINT; End; Function IsWinXP: Boolean; Begin. Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and. (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1); End; Procedure TXPHintWindow.CreateParams(var Params: TCreateParams); Const. CS_DROPSHADOW = $00020000; Begin. Inherited; If IsWinXP then. Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW; End; Procedure TXPHintWindow.WMNCPaint(var msg: TMessage); Var. R: TRect; DC: HDC; Begin. DC := GetWindowDC(Handle); Try. R := Rect(0, 0, Width, Height); DrawEdge(DC, R, EDGE_ETCHED, BF_RECT or BF_MONO); Finally. ReleaseDC(Handle, DC); End; End; Initialization. HintWindowClass := TXPHintWindow; Application.ShowHint := False; Application.ShowHint := True; End.

Как снять пароль с Excel файла?

Code: { Today I want to show how you may load some xls-file that is. Password-protected, and how to save xls into another file. But without protection. Just replace there file names and password... } Var. Xls, xlw: Variant; Begin. {load MS Excel}. Xls := CreateOLEObject('Excel.Application'); {open your xls-file}. Xlw := xls.WorkBooks.Open(FileName := 'd:\book1.xls', Password := 'qq', ReadOnly := True); {save with other file name}. Xlw.SaveAs(FileName := 'd:\book2.xls', Password := ''); {unload MS Excel}. Xlw := UnAssigned; Xls := UnAssigned; End;

Как работать с fade для TImage?

Code: Type. PRGBTripleArray = ^TRGBTripleArray; TRGBTripleArray = array[0..32767] of TRGBTriple; ///////////////////////////////////////////////// // Fade In // ///////////////////////////////////////////////// Procedure FadeIn(ImageFileName: TFileName); Var. Bitmap, BaseBitmap: TBitmap; Row, BaseRow: PRGBTripleArray; X, y, step: integer; Begin. // Bitmaps vorbereiten / Preparing the Bitmap // Bitmap := TBitmap.Create; Try. Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit // Bitmap.LoadFromFile(ImageFileName); BaseBitmap := TBitmap.Create; Try. BaseBitmap.PixelFormat := pf32bit; BaseBitmap.Assign(Bitmap); // Fading // For step := 0 to 32 do. Begin. For y := 0 to (Bitmap.Height - 1) do. Begin. BaseRow := BaseBitmap.Scanline[y]; // Farben vom Endbild holen / Getting colors from final image // Row := Bitmap.Scanline[y]; // Farben vom aktuellen Bild / Colors from the image as it is now // For x := 0 to (Bitmap.Width - 1) do. Begin. Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5; Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading // Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5; End; End; Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image // InvalidateRect(Form1.Handle, nil, False); // Fenster neu zeichnen / Redraw window // RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW); End; Finally. BaseBitmap.Free; End; Finally. Bitmap.Free; End; End; ///////////////////////////////////////////////// // Fade Out // ///////////////////////////////////////////////// Procedure FadeOut(ImageFileName: TFileName); Var. Bitmap, BaseBitmap: TBitmap; Row, BaseRow: PRGBTripleArray; X, y, step: integer; Begin. // Bitmaps vorbereiten / Preparing the Bitmap // Bitmap := TBitmap.Create; Try. Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit // Bitmap.LoadFromFile(ImageFileName); BaseBitmap := TBitmap.Create; Try. BaseBitmap.PixelFormat := pf32bit; BaseBitmap.Assign(Bitmap); // Fading // For step := 32 downto 0 do. Begin. For y := 0 to (Bitmap.Height - 1) do. Begin. BaseRow := BaseBitmap.Scanline[y]; // Farben vom Endbild holen / Getting colors from final image // Row := Bitmap.Scanline[y]; // Farben vom aktuellen Bild / Colors from the image as it is now // For x := 0 to (Bitmap.Width - 1) do. Begin. Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5; Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading // Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5; End; End; Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image // InvalidateRect(Form1.Handle, nil, False); // Fenster neu zeichnen / Redraw window // RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW); End; Finally. BaseBitmap.Free; End; Finally. Bitmap.Free; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. FadeIn('C:\TestImage.bmp'). End; {*****************************} {by Yucel Karapinar, ykarapinar@hotmail.com }. { Only for 24 ve 32 bits bitmaps }. Procedure FadeOut(const Bmp: TImage; Pause: Integer); Var. BytesPorScan, counter, w, h: Integer; P: pByteArray; Begin. If not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then. Raise Exception.Create('Error, bitmap format is not supporting.'); Try. BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) - Integer(Bmp.Picture.Bitmap.ScanLine[0])); Except. Raise Exception.Create('Error!!'); End; For counter := 1 to 256 do. Begin. For h := 0 to Bmp.Picture.Bitmap.Height - 1 do. Begin. P := Bmp.Picture.Bitmap.ScanLine[h]; For w := 0 to BytesPorScan - 1 do. If P^[w] > 0 then P^[w] := P^[w] - 1; End; Sleep(Pause); Bmp.Refresh; End; End; Procedure TForm1.Button2Click(Sender: TObject); Begin. FadeOut(Image1, 1); End;

BMP ---> EMF.

Code: Function bmp2emf(const SourceFileName: TFileName): Boolean; // Converts a Bitmap to a Enhanced Metafile (*.emf). Var. Metafile: TMetafile; MetaCanvas: TMetafileCanvas; Bitmap: TBitmap; Begin. Metafile := TMetaFile.Create; Try. Bitmap := TBitmap.Create; Try. Bitmap.LoadFromFile(SourceFileName); Metafile.Height := Bitmap.Height; Metafile.Width := Bitmap.Width; MetaCanvas := TMetafileCanvas.Create(Metafile, 0); Try. MetaCanvas.Draw(0, 0, Bitmap); Finally. MetaCanvas.Free; End; Finally. Bitmap.Free; End; Metafile.SaveToFile(ChangeFileExt(SourceFileName, '.emf')); Finally. Metafile.Free; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Bmp2emf('C:\TestBitmap.bmp'); End;

Как создать каретку свой собственной формы?

Code: { The example below demonstrates creating custom caret: } Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; Type. TForm1 = class(TForm). Memo1: TMemo; Image1: TImage; Edit1: TEdit; Procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. CreateCaret(Memo1.Handle, Image1.Picture.Bitmap.Handle, 0, 0); ShowCaret(Memo1.Handle); End; Procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. CreateCaret(Edit1.Handle, 0, 10, 4); ShowCaret(Edit1.Handle); End; End. {The form file source (*.dfm) }. Object Form1: TForm1. Left = 192. Top = 107. Width = 544. Height = 375. Caption = 'Form1' Color = clBtnFace. Font.Charset = DEFAULT_CHARSET. Font.Color = clWindowText. Font.Height = -11. Font.Name = 'MS Sans Serif' Font.Style = []. OldCreateOrder = False. PixelsPerInch = 96. TextHeight = 13. Object Image1: TImage. Left = 12. Top = 4. Width = 16. Height = 16. AutoSize = True. Picture.Data = { 07544269746D6170B6020000424DB602000000000000B6000000280000001000. 0000100000000100100000000000000200000000000000000000100000000000. 000000000000000080000080000000808000800000008000800080800000C0C0. C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF. FF00000000000000000000000000000000000000000000000000000000000000. 0000000000000000000000000000000000000000000000000000000000000000. 000000000000FF7FFF7FFF7FFF7F000000000000FF7FFF7FFF7FFF7FFF7FFF7F. 00000000FF7FFF7FFF7FFF7F000000000000FF7FFF7FFF7FFF7FFF7FFF7F0000. 0000FF7FFF7FFF7FFF7FFF7F00000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000. 000000000000FF7FFF7FFF7F0000000000000000FF7FFF7FFF7FFF7F00000000. 0000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F00000000. 0000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F000000000000. 0000000000000000FF7FFF7FFF7F00000000FF7FFF7FFF7FFF7F000000000000. 00000000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000000000000000. 00000000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000000000000000. 000000000000000000000000FF7FFF7FFF7FFF7FFF7FFF7F0000000000000000. 000000000000000000000000FF7FFF7FFF7FFF7FFF7F00000000000000000000. 0000000000000000000000000000FF7FFF7FFF7FFF7F00000000000000000000. 0000000000000000000000000000FF7FFF7FFF7F000000000000000000000000. 00000000000000000000000000000000FF7F0000000000000000000000000000. 0000}. End. Object Memo1: TMemo. Left = 12. Top = 36. Width = 149. Height = 149. Lines.Strings = ('Memo1'). TabOrder = 0. OnMouseDown = Memo1MouseDown. End. Object Edit1: TEdit. Left = 220. Top = 60. Width = 121. Height = 21. TabOrder = 1. Text = 'Edit1' OnMouseDown = Edit1MouseDown. End. End.

Как автоматически заполнить поля формы в IE?

Code: { This example shows how to automatically fill in a search string. In the "Search Tip" page and click the search button. } Uses. MSHTML_TLB; // first navigate to tipspage. Procedure TForm1.Button1Click(Sender: TObject); Begin. Webbrowser1.Navigate('http://www.swissdelphicenter.ch/en/tipsuchen.php'); End; // Try to access IE instance and fill out the search field with. // a text and click the search button. Procedure TForm1.Button3Click(Sender: TObject); Var. HIE: HWND; ShellWindow: IShellWindows; WB: IWebbrowser2; SpDisp: IDispatch; IDoc1: IHTMLDocument2; Document: Variant; K, m: Integer; OvElements: OleVariant; I: Integer; Begin. ShellWindow := CoShellWindows.Create; // get the running instance of Internet Explorer. For k := 0 to ShellWindow.Count do. Begin. SpDisp := ShellWindow.Item(k); If spDisp = nil then Continue; // QueryInterface determines if an interface can be used with an object. 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; Begin. Document := WB.Document; // count forms on document and iterate through its forms. For m := 0 to Document.forms.Length - 1 do. Begin. OvElements := Document.forms.Item(m).elements; // iterate through elements. For i := 0 to ovElements.Length - 1 do. Begin. // when input fieldname is found, try to fill out. Try. If (CompareText(ovElements.item(i).tagName, 'INPUT') = 0) and. (CompareText(ovElements.item(i).type, 'text') = 0) then. Begin. OvElements.item(i).Value := 'FindWindow'; End; Except. End; // when Submit button is found, try to click. Try. If (CompareText(ovElements.item(i).tagName, 'INPUT') = 0) and. (CompareText(ovElements.item(i).type, 'SUBMIT') = 0) and. (ovElements.item(i).Value = 'Search') then // Suchen fьг German. Begin. OvElements.item(i).Click; End; Except. End; End; End; End; End; End; End; End;

Как выполнить Javascript функцию?

Code: Uses. MSHTML_TLB, SHDocVw, ShellAPI; // function to execute a script function. Function ExecuteScript(doc: IHTMLDocument2; script: string; language: string): Boolean; Var. Win: IHTMLWindow2; Olelanguage: Olevariant; Begin. If doc <> nil then. Begin. Try. Win := doc.parentWindow; If win <> nil then. Begin. Try. Olelanguage := language; Win.ExecScript(script, Olelanguage); Finally. Win := nil; End; End; Finally. Doc := nil; End; End; End; // 2 Examples how to login to gmx homepage. Procedure FillInGMXForms(WB: ShDocVW_TLB.IWebbrowser2; IDoc1: IHTMLDocument2; Document: Variant; AKennung, APasswort: string); Const. IEFields: array[1..4] of string = ('INPUT', 'text', 'INPUT', 'password'); Var. IEFieldsCounter: Integer; I: Integer; M: Integer; OvElements: OleVariant; Begin. If Pos('GMX - Homepage', Document.Title) <> 0 then. While WB.ReadyState <> READYSTATE_COMPLETE do. Application.ProcessMessages; // count forms on document and iterate through its forms. IEFieldsCounter := 0; For m := 0 to Document.forms.Length - 1 do. Begin. OvElements := Document.forms.Item(m).elements; // iterate through elements. For i := ovElements.Length - 1 downto 0 do. Begin. Try. // if input fields found, try to fill them out. If (ovElements.item(i).tagName = IEFields[1]) and. (ovElements.item(i).type = IEFields[2]) then. Begin. OvElements.item(i).Value := AKennung; Inc(IEFieldsCounter); End; If (ovElements.item(i).tagName = IEFields[3]) and. (ovElements.item(i).type = IEFields[4]) then. Begin. OvElements.item(i).Value := APasswort; Inc(IEFieldsCounter); End; Except. // failed... End; End; { for i...}. End; { for m }. // if the fields are filled in, submit. If IEFieldsCounter = 3 then ExecuteScript(iDoc1, 'document.login.submit()', 'JavaScript'); End; Function LoginGMX_IE(AKennung, APasswort: string): Boolean; Var. ShellWindow: IShellWindows; WB: ShDocVW_TLB.IWebbrowser2; SpDisp: IDispatch; IDoc1: IHTMLDocument2; Document: Variant; K: Integer; Begin. ShellWindow := CoShellWindows.Create; // get the running instance of Internet Explorer. For k := 0 to ShellWindow.Count do. Begin. SpDisp := ShellWindow.Item(k); If spDisp = nil then Continue; // QueryInterface determines if an interface can be used with an object. SpDisp.QueryInterface(iWebBrowser2, WB); If WB <> nil then. Begin. WB.Document.QueryInterface(IHTMLDocument2, iDoc1); If iDoc1 <> nil then. Begin. WB := ShellWindow.Item(k) as ShDocVW_TLB.IWebbrowser2; Document := WB.Document; // if GMX page... FillInGMXForms(WB, IDoc1, Document, AKennung, APasswort); End; { idoc <> nil }. End; { wb <> nil }. End; { for k }. End; // Example 1: Navigate to the gmx homepage in the IE browser an login. Procedure TForm1.Button1Click(Sender: TObject); Begin. ShellExecute(Handle, 'open', 'http://www.gmx.ch', Nil, Nil, SW_SHOW); Sleep(2000); LoginGMX_IE('user@gmx.net', 'pswd'); End; // Example 2: navigate to the gmx homepage in the Webbrowser an login. Procedure TForm1.Button2Click(Sender: TObject); Var. IDoc1: IHTMLDocument2; Web: ShDocVW_TLB.IWebBrowser2; Begin. Webbrowser1.Navigate('http://www.gmx.ch'); While Webbrowser1.ReadyState <> READYSTATE_COMPLETE do. Application.ProcessMessages; Webbrowser1.Document.QueryInterface(IHTMLDocument2, iDoc1); Web := WebBrowser1.ControlInterface; FillInGMXForms(Web, iDoc1, Webbrowser1.Document, 'user@gmx.net', 'pswd'); End;

Как нажать кнопку в TWebbrowser когда в окне есть несколько кнопок?

Code: // If there is only one button, you can do something like: WebBrowser1.OleObject.Document.forms.item(0).elements.item(0).click; // This will do a click on the first element of the first <FORM>, where an. // element is either <INPUT>, <SELECT> or <TEXTAREA>. // If there is more than one button, you can do something like: Procedure TForm1.Button1Click(Sender: TObject); Var. OvElements: OleVariant; I: Integer; Begin. OvElements := WebBrowser1.OleObject.Document.forms.item(0).elements; For i := 0 to (ovElements.Length - 1) do. If (ovElements.item(i).tagName = 'INPUT') and. (ovElements.item(i).type = 'SUBMIT') and. (ovElements.item(i).Value = 'Recent Charges') then. OvElements.item(i).Click; End;

Как узнать версию Internet Explorer?

Code: Uses. Registry; Function GetIEVersion(Key: string): string; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_LOCAL_MACHINE; Reg.OpenKey('Software\Microsoft\Internet Explorer', False); Try. Result := Reg.ReadString(Key); Except. Result := ''; End; Reg.CloseKey; Finally. Reg.Free; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. ShowMessage('IE-Version: ' + GetIEVersion('Version')[1] + '.' + GetIEVersion('Version')[3]); ShowMessage('IE-Version: ' + GetIEVersion('Version')); // <major version>.<minor version>.<build number>.<sub-build number> End;

Как проверить является ли текущее соединение в TWebbrowser secure (SSL)?

Code: // You need a TWebbrowser, a TLabel. Procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; Const pDisp: IDispatch; var URL: OleVariant); Begin. If Webbrowser1.Oleobject.Document.Location.Protocol = 'https:' then. Label1.Caption := 'Sichere Verbindung' Else. Label1.Caption := 'Unsichere Verbindung' End;

Найти и выделить текст в TWebBrowser?

Code: {....} Private. Procedure SearchAndHighlightText(aText: string); {....} Procedure TForm1.SearchAndHighlightText(aText: string); Var. I: Integer; Begin. For i := 0 to WebBrowser1.OleObject.Document.All.Length - 1 do. Begin. If Pos(aText, WebBrowser1.OleObject.Document.All.Item(i).InnerText) <> 0 then. Begin. WebBrowser1.OleObject.Document.All.Item(i).Style.Color := '#FFFF00'; WebBrowser1.OleObject.Document.All.Item(i).ScrollIntoView(True); End; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. SearchAndHighlightText('some text...'); End;

Найти smtp mailserver по умолчанию?

Code: { Here is some code I successfully used te determine. The DEFAULT mailaccount, which is used in. Outlook Express, to send outgoing mail via SMTP. } Procedure TForm1.ReadRegistryDefaults; Var. Registry: TRegistry; AccountStr: string; Begin. Registry := TRegistry.Create; Try. Registry.RootKey := hkey_CURRENT_USER; If Registry.OpenKey('software\microsoft\internet account manager', False) then {}. Begin. AccountStr := Registry.ReadString('default mail account'); Registry.CloseKey; If (AccountStr <> '') then. If Registry.OpenKey('software\microsoft\internet account manager\accounts\' + AccountStr, False) then {}. Begin. Edit_Server.Text := Registry.ReadString('SMTP Server'); Edit_Account.Text := Registry.ReadString('SMTP Email Address'); Registry.CloseKey; End; End; Finally. Registry.Free; End; End;

Как показать Choose Computer диалог?

Code: { The "Choose Computer" is a dialog provided by network services. (NTLANMAN.DLL) for Windows 2k/NT/XP. To display the servers and their computers. } Type. TServerBrowseDialogA0 = function(hwnd: HWND; pchBuffer: Pointer; cchBufSize: DWORD): bool; Stdcall; Function ShowServerDialog(AHandle: THandle): string; Var. ServerBrowseDialogA0: TServerBrowseDialogA0; LANMAN_DLL: DWORD; Buffer: array[0..1024] of char; BLoadLib: Boolean; Begin. LANMAN_DLL := GetModuleHandle('NTLANMAN.DLL'); If LANMAN_DLL = 0 then. Begin. LANMAN_DLL := LoadLibrary('NTLANMAN.DLL'); BLoadLib := True; End; If LANMAN_DLL <> 0 then. Begin @ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, 'ServerBrowseDialogA0'); DialogBox(HInstance, MAKEINTRESOURCE(101), AHandle, nil); ServerBrowseDialogA0(AHandle, @buffer, 1024); If buffer[0] = '\' then. Begin. Result := buffer; End; If bLoadLib then. FreeLibrary(LANMAN_DLL); End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Label1.Caption := ShowServerDialog(Form1.Handle); End;

Как загрузить HTML код непосредственно в TWebbrowser?

Code: Uses. ActiveX; Procedure WB_LoadHTML(WebBrowser: TWebBrowser; HTMLCode: string); Var. Sl: TStringList; Ms: TMemoryStream; Begin. WebBrowser.Navigate('about:blank'); While WebBrowser.ReadyState < READYSTATE_INTERACTIVE do. Application.ProcessMessages; If Assigned(WebBrowser.Document) then. Begin. Sl := TStringList.Create; Try. Ms := TMemoryStream.Create; Try. Sl.Text := HTMLCode; Sl.SaveToStream(ms); Ms.Seek(0, 0); (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)); Finally. Ms.Free; End; Finally. Sl.Free; End; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. WB_LoadHTML(WebBrowser1,'SwissDelphiCenter'); End;

Как загрузить файл?

Code: { The following function shows how to connect to a ftp server. And download a file. It uses the functions from wininet.dll. You need a ProgressBar to show the progress and a Label to show progress informations. } Uses. WinInet, ComCtrls; Function FtpDownloadFile(strHost, strUser, strPwd: string; Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean; Function FmtFileSize(Size: Integer): string; Begin. If Size >= $F4240 then. Result := Format('%.2f', [Size / $F4240]) + ' Mb' Else. If Size < 1000 then. Result := IntToStr(Size) + ' bytes' Else. Result := Format('%.2f', [Size / 1000]) + ' Kb'; End; Const. READ_BUFFERSIZE = 4096; // or 256, 512, ... Var. HNet, hFTP, hFile: HINTERNET; Buffer: array[0..READ_BUFFERSIZE - 1] of Char; Bufsize, dwBytesRead, fileSize: DWORD; SRec: TWin32FindData; StrStatus: string; LocalFile: file; BSuccess: Boolean; Begin. Result := False; { Open an internet session }. HNet := InternetOpen('Program_Name', // Agent. INTERNET_OPEN_TYPE_PRECONFIG, // AccessType. Nil, // ProxyName. Nil, // ProxyBypass. 0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE. { Agent contains the name of the application or. Entity calling the Internet functions. } { See if connection handle is valid }. If hNet = nil then. Begin. ShowMessage('Unable to get access to WinInet.Dll'); Exit; End; { Connect to the FTP Server }. HFTP := InternetConnect(hNet, // Handle from InternetOpen. PChar(strHost), // FTP server. Port, // (INTERNET_DEFAULT_FTP_PORT), PChar(StrUser), // username. PChar(strPwd), // password. INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher? 0, // flag: 0 or INTERNET_FLAG_PASSIVE. 0);// User defined number for callback. If hFTP = nil then. Begin. InternetCloseHandle(hNet); ShowMessage(Format('Host "%s" is not available',[strHost])); Exit; End; { Change directory }. BSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir)); If not bSuccess then. Begin. InternetCloseHandle(hFTP); InternetCloseHandle(hNet); ShowMessage(Format('Cannot set directory to %s.',[ftpDir])); Exit; End; { Read size of file }. If FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then. Begin. FileSize := sRec.nFileSizeLow; // fileLastWritetime := sRec.lastWriteTime. End else. Begin. InternetCloseHandle(hFTP); InternetCloseHandle(hNet); ShowMessage(Format('Cannot find file ',[ftpFile])); Exit; End; { Open the file }. HFile := FtpOpenFile(hFTP, // Handle to the ftp session. PChar(ftpFile), // filename. GENERIC_READ, // dwAccess. FTP_TRANSFER_TYPE_BINARY, // dwFlags. 0); // This is the context used for callbacks. If hFile = nil then. Begin. InternetCloseHandle(hFTP); InternetCloseHandle(hNet); Exit; End; { Create a new local file }. AssignFile(LocalFile, TargetFile); {$i-}. Rewrite(LocalFile, 1); {$i+}. If IOResult <> 0 then. Begin. InternetCloseHandle(hFile); InternetCloseHandle(hFTP); InternetCloseHandle(hNet); Exit; End; DwBytesRead := 0; Bufsize := READ_BUFFERSIZE; While (bufsize > 0) do. Begin. Application.ProcessMessages; If not InternetReadFile(hFile, @buffer, // address of a buffer that receives the data. READ_BUFFERSIZE, // number of bytes to read from the file. Bufsize) then Break; // receives the actual number of bytes read. If (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then. BlockWrite(LocalFile, buffer, bufsize); DwBytesRead := dwBytesRead + bufsize; { Show Progress }. ProgressBar.Position := Round(dwBytesRead * 100 / fileSize); Form1.Label1.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]); End; CloseFile(LocalFile); InternetCloseHandle(hFile); InternetCloseHandle(hFTP); InternetCloseHandle(hNet); Result := True; End;

Как добавить текущую страницу TWebbrowser в favorites?

Code: // You need: 1 TEdit, 2 TButtons, 1 TWebbrowser. // Du brauchst: 1 TEdit, 2 TButtons, 1 TWebbrowser. Const. NotAllowed: set of Char = ['"'] + ['/'] + ['\'] + ['?'] + [':'] + ['*'] + ['<'] + ['>'] + ['|']; Implementation. {$R *.DFM}. Function Load(Path, Key: string): string; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_CURRENT_USER; Reg.OpenKey(Path, False); Try. Result := Reg.ReadString(Key); Except. Result := ''; End; Reg.CloseKey; Finally. Reg.Free; End; End; Function WinDir: string; Var. WinDir: PChar; Begin. WinDir := StrAlloc(MAX_PATH); GetWindowsDirectory(WinDir, MAX_PATH); Result := string(WinDir); If Result[Length(Result)] <> '\' then. Result := Result + '\'; StrDispose(WinDir); End; Function GetSysDir: string; Var. Dir: array [0..MAX_PATH] of Char; Begin. GetSystemDirectory(dir, MAX_PATH); Result := StrPas(dir); End; // Navigate to a page. Procedure TForm1.Button1Click(Sender: TObject); Begin. Webbrowser1.Navigate(edit1.Text); End; // Add the current page to the favorites. Procedure TForm1.Button2Click(Sender: TObject); Var. Url: TStringList; Fav: string; Title, b: string; I: Integer; C: Char; Begin. Fav := Load('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders','Favorites'); Url := TStringList.Create; Try. Url.Add('[InternetShortcut]'); Url.Add('URL=' + webbrowser1.LocationURL); Url.Add('WorkingDirectory=' + WinDir()); Url.Add('IconIndex=0'); Url.Add('ShowCommand=7'); Url.Add('IconFile=' + GetSysDir() + '\url.dll'); Title := Webbrowser1.LocationName; B := ''; For i := 1 to Length(title) do. Begin. C := title[i]; If not (c in NotAllowed) then. Begin. B := b + Webbrowser1.LocationName[i]; End; End; Url.SaveToFile(fav + '\' + b + '.url'); Finally. Url.Free; End; End; End.

Как послать сообщение?

Code: { You need 3 TEdits, 1 TMemo and 1 TClientSocket. Set the TClientsocket's Port to 80 and the Host to wwp.mirabilis.com. } Var. Form1: TForm1; Csend: string; Implementation. {$R *.dfm}. Procedure TForm1.Button1Click(Sender: TObject); Begin. CSend := 'POST http://wwp.icq.com/scripts/WWPMsg.dll HTTP/2.0' + chr(13) + chr(10); CSend := cSend + 'Referer: http://wwp.mirabilis.com' + chr(13) + chr(10); CSend := cSend + 'User-Agent: Mozilla/4.06 (Win95; I)' + chr(13) + chr(10); CSend := cSend + 'Connection: Keep-Alive' + chr(13) + chr(10); CSend := cSend + 'Host: wwp.mirabilis.com:80' + chr(13) + chr(10); CSend := cSend + 'Content-type: application/x-www-form-urlencoded' + chr(13) + chr(10); CSend := cSend + 'Content-length:8000' + chr(13) + chr(10); CSend := cSend + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + Chr(13) + chr(10) + chr(13) + chr(10); CSend := cSend + 'from=' + edit1.Text + ' &fromemail=' + edit2.Text + ' &fromicq:110206786' + ' &body=' + memo1.Text + ' &to=' + edit3.Text + '&Send='; Clientsocket1.Active := True; End; Procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); Begin. Clientsocket1.Socket.SendText(csend); Clientsocket1.Active := False; End;

Как получить длину wav в секундах?

Code: Uses. MPlayer, MMsystem; Type. EMyMCIException = class(Exception); TWavHeader = record. Marker1: array[0..3] of Char; BytesFollowing: Longint; Marker2: array[0..3] of Char; Marker3: array[0..3] of Char; Fixed1: Longint; FormatTag: Word; Channels: Word; SampleRate: Longint; BytesPerSecond: Longint; BytesPerSample: Word; BitsPerSample: Word; Marker4: array[0..3] of Char; DataBytes: Longint; End; Procedure TForm1.Button1Click(Sender: TObject); Var. Header: TWavHeader; Begin. With TFileStream.Create('C:\SomeFile.wav', fmOpenRead) do. Try. ReadBuffer(Header, SizeOf(Header)); Finally. Free; End; ShowMessage(FloatToStr((Int64(1000) * header.DataBytes div header.BytesPerSecond) / 1000)); End;

Как прочитать/изменить startpage IE?

Code: Uses. {...,}Registry; Function GetIEStartPage: string; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_CURRENT_USER; Reg.OpenKey('Software\Microsoft\Internet Explorer\Main', False); Try. Result := Reg.ReadString('Start Page'); Except. Result := ''; End; Reg.CloseKey; Finally. Reg.Free; End; End; Function SetIEStartPage(APage: string): Boolean; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_CURRENT_USER; Reg.OpenKey('Software\Microsoft\Internet Explorer\Main', False); Try. Reg.WriteString('Start Page', APage); Result := True; Finally. Reg.CloseKey; Result := False; End; Finally. Reg.Free; End; End; // Show the Startpage. Procedure TForm1.Button1Click(Sender: TObject); Begin. ShowMessage(GetIEStartPage); End; // Set the Startpage. Procedure TForm1.Button2Click(Sender: TObject); Begin. SetIEStartPage('http://forum.vingrad.ru'); End;

Как скрыть контекстное меню TWebbrowser?

Code: Var. HookID: THandle; Function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall; Var. SzClassName: array[0..255] of Char; Const. Ie_name = 'Internet Explorer_Server'; Begin. Case nCode < 0 of. True: Result := CallNextHookEx(HookID, nCode, wParam, lParam). Else. Case wParam of. WM_RBUTTONDOWN, WM_RBUTTONUP: Begin. GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName)); If lstrcmp(@szClassName[0], @ie_name[1]) = 0 then. Result := HC_SKIP. Else. Result := CallNextHookEx(HookID, nCode, wParam, lParam); End. Else. Result := CallNextHookEx(HookID, nCode, wParam, lParam); End; End; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId()); End; Procedure TForm1.FormDestroy(Sender: TObject); Begin. If HookID <> 0 then. UnHookWindowsHookEx(HookID); End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Webbrowser1.Navigate('http://www.google.com'); End;

Использоватние Drag and Drop для заполнения полей в TWebBrowser?

Code: This example shows how to fill out fields in your webbrowser by. Dragging the content of Label1 to a field of your webbrowser}. Procedure TForm1.FormCreate(Sender: TObject); Begin. Label1.DragMode := dmAutomatic; End; Procedure TForm1.WebBrowserDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Var. Item: Variant; Begin. //check if document is interactive. If (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then. Begin. Item := WebBrowser.OleObject.Document.elementFromPoint(x, y); If Source is TLabel then. Accept := True; Accept := (item.tagname = 'INPUT') and ((item.type = 'text') or. (item.type = 'password')) or (item.tagname = 'TEXTAREA'); End; End; Procedure TForm1.WebBrowserDragDrop(Sender, Source: TObject; X, Y: Integer); Var. Item: Variant; Begin. //check if document is interactive. If (Webbrowser.ReadyState and READYSTATE_INTERACTIVE) = 3 then. Begin. Item := WebBrowser.OleObject.Document.elementFromPoint(x, y); Item.Value := label1.Caption; End; End;

Как определить установлен ли Internet Explorer?

Code: Uses. Registry; Function IE_installed(var Version: string): Boolean; Var. Reg: TRegistry; Begin. Reg := TRegistry.Create; With Reg do. Begin. RootKey := HKEY_LOCAL_MACHINE; OpenKey('Software\Microsoft\Internet Explorer', False); If ValueExists('Version') then. Version := ReadString('Version'). Else. Version := ''; CloseKey; Free; End; Result := Version <> ''; End; Procedure TForm1.Button1Click(Sender: TObject); Var. IE_Version: string; Begin. If IE_Installed(IE_Version) then. ShowMessage(Format('Internet Explorer %s installed.', [IE_Version])); End;

Как узнать browser по умолчанию?

Code: { First we create a temporary file and call the. Function FindExecutable to get the associated Application. } Function GetAppName(Doc: string): string; Var. FN, DN, RES: array[0..255] of char; Begin. StrPCopy(FN, DOC); DN[0] := #0; RES[0] := #0; FindExecutable(FN, DN, RES); Result := StrPas(RES); End; Function GetTempFile(const Extension: string): string; Var. Buffer: array[0..MAX_PATH] of char; AFile: string; Begin. GetTempPath(SizeOf(Buffer) - 1, Buffer); GetTempFileName(Buffer, 'TMP', 0, Buffer); SetString(aFile, Buffer, StrLen(Buffer)); Result := ChangeFileExt(aFile, Extension); End; Procedure TForm1.Button1Click(Sender: TObject); Var. F: System.Text; Temp: string; Begin. // get a unique temporary file name. // eine eindeutige Temporare Datei bekommen. Temp := GetTempFile('.htm'); // Create the file. // Datei erstellen. AssignFile(f, temp); Rewrite(f); Closefile(f); // Show the path to the browser. // Pfad + Programmname zum Browser anzeigen. ShowMessage(GetAppName(temp)); // Finally delete the temporary file. // Temporaare Datei wieder loschen. Erase(f); End;

©Drkb::03503.

Code: //Using the Registry: //************************************************ Uses. Registry; Procedure TForm1.Button1Click(Sender: TObject); Var. Reg: TRegistry; KeyName: string; ValueStr: string; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_CLASSES_ROOT; KeyName := 'htmlfile\shell\open\command'; If Reg.OpenKey(KeyName, False) then. Begin. ValueStr := Reg.ReadString(''); Reg.CloseKey; ShowMessage(ValueStr); End. Else. ShowMessage('There is nоt a default browser'); Finally. Reg.Free; End; End;

©Drkb::03504.

Code: //************************************************ {Copyright (c) by Code Central}. Type. TBrowserInformation = record. Name: string; Path: string; Version: string; End; Function LongPathName(ShortPathName: string): string; Var. PIDL: PItemIDList; Desktop: IShellFolder; WidePathName: WideString; AnsiPathName: AnsiString; Begin. Result := ShortPathName; If Succeeded(SHGetDesktopFolder(Desktop)) then. Begin. WidePathName := ShortPathName; If Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(WidePathName), ULONG(nil^), PIDL, ULONG(nil^))) then. Try. SetLength(AnsiPathName, MAX_PATH); SHGetPathFromIDList(PIDL, PChar(AnsiPathName)); Result := PChar(AnsiPathName); Finally. CoTaskMemFree(PIDL); End; End; End; Function GetDefaultBrowser: TBrowserInformation; Var. Tmp: PChar; Res: LPTSTR; Version: Pointer; VersionInformation: Pointer; VersionInformationSize: Integer; Dummy: DWORD; Begin. Tmp := StrAlloc(255); Res := StrAlloc(255); Version := nil; Try. GetTempPath(255, tmp); If FileCreate(tmp + 'htmpl.htm') <> -1 then. Begin. If FindExecutable('htmpl.htm', tmp, res) > 32 then. Begin. Result.Name := ExtractFileName(res); Result.Path := LongPathName(ExtractFilePath(res)); // Try to determine the Browser Version. VersionInformationSize := GetFileVersionInfoSize(Res, Dummy); If VersionInformationSize > 0 then. Begin. GetMem(VersionInformation, VersionInformationSize); GetFileVersionInfo(Res, 0, VersionInformationSize, VersionInformation); VerQueryValue(VersionInformation, ('StringFileInfo040904E4ProductVersion'), Pointer(Version), Dummy); If Version <> nil then. Result.Version := PChar(Version); FreeMem(VersionInformation); End; End. Else. ShowMessage('Cannot determine the executable.'); SysUtils.DeleteFile(tmp + 'htmpl.htm'); End. Else. ShowMessage('Cannot create temporary file.'); Finally. StrDispose(tmp); StrDispose(res); End; End;

©Drkb::03505.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Как узнать тип соединения с интернетом?

Code: Uses. WinInet; Const. MODEM = 1; LAN = 2; PROXY = 4; BUSY = 8; Function GetConnectionKind(var strKind: string): Boolean; Var. Flags: DWORD; Begin. StrKind := ''; Result := InternetGetConnectedState(@flags, 0); If Result then. Begin. If (flags and MODEM) = MODEM then strKind := 'Modem'; If (flags and LAN) = LAN then strKind := 'LAN'; If (flags and PROXY) = PROXY then strKind := 'Proxy'; If (flags and BUSY) = BUSY then strKind := 'Modem Busy'; End; End; Procedure TForm1.Button1Click(Sender: TObject); Var. StrKind: string; Begin. If GetConnectionKind(strKind) then. ShowMessage(strKind); End;

©Drkb::03574.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Описание работы с AWE.

Этот раздел описывает расширение адресной оболочки Windows (Address Windowing Extention, AWE). Это расширение Windows 2000 предоставляет возможность пользовательским приложениям адресовать более чем 32 бита адресного пространства.

Windows NT и Windows 2000 предоставляют своим приложениям сплошное 32-х битовое адресное пространство, которое описывает 4 Гб виртуальной памяти. Это адресное пространство обычно разбито таким образом, что только 2 Гб непосредственно доступны для нужд приложения. Другие 2 Гб доступны только закрытому коду, принадлежащему операционной системе. Добавим, что начиная с Windows NT 4 SP 3 и Windows NT Server Enterprise Edition/Windows 2000 Advanced Server на базе процессора x86 на нужды приложения выделяется 3 Гб, а закрытому коду - 1 Гб.

AWE является набором расширений, которые предоставляют пользователю возможность пользователю напрямую выделять и фиксировать страницы в оперативной памяти. В этом случае приложения могут быстро оперировать с физичекой памятью, превышающей 4 Гб. Некоторые приложения, связанные с интесивной обработкой данных, такие как систмы управления базами данных, а также нучные и инженерные приложения, нуждаются в доступе к очень огромным кешам данных. В этом случае, размер кеша ограничивается 2 Гб, доступными приложениями, что иногда являеться жестким ограничением. В этих случаях, приложения могут использовать под кеш небольшие объемы данных.

AWE решает эту проблему путем разрешения приложению непосредственно адресовать гигантскую память, в то время как оно может использовать и обычную 32-х битную адресацию. AWE предоставляет для приложений возможность иметь под кеш более чем 4 Гб (при условии, что существует соответствующая физическая память).

Использование AWE связано с некоторыми ограничениями на использование такой памяти, главным образом эти ограничения связаны с предоставлением критичного по скорости распределением, перераспределением и освободением памяти.

* Виртуальное адресное пространство, выделенное средствами AWE, нельзя разделить с другими процессами (и, поэтому, оно не является наследуемым). Невозможно также две различные страницы виртуального адресного пространства спроецировать на одну страницу оперативной памяти. Эти ограничения позволяют сделать быстрой операции перепроецирования и очистки памяти при ее освобождении.

* Физическая память, когорая может быть выделена в AWE регионе, ограничена количеством физической памяти, которая присутсвует на компьютере. Так как эта память является фиксированной, то она блокируется до тех пор, пока приложение ее не освободит (либо до тех пор, пока приложение существует). Физические страницы памяти, выделенные для данного процесса, могут быть спроектированы в любой AWE регион, связанный с этим процессом. Приложение, которое использует AWE, должно быть очень аккуратным, поскольку может забрать на свои нужды столько памяти, что оставшиеся приложения будут иметь интенсивный обмен с файлом подкачки, либо будет предотвращена попытка создания новых процессов и потоков по причине нехватки рессурсов. Используйте функцию {GlobalMemoryStatusEx} для того, чтобы отследить использование физической памяти.

* Виртуальное адресное простаранство, выделенное средствами AWE, всегда доступно для чтения/записи, поэтому к ней неприменимы вызовы функции {VirtualProtect} (поскольку не существует памяти, доступной только для чтения, памяти без доступа, защиты страниц и прочих спецификаторов).

* Диапазон адресов AWE не может быть использован в качестве буфера для графических или видео вызовов.

* Регион памяти AWE не может быть разбит на части, которые затем можно было бы удалить. Весь регион может быть удален только как единое целое, когда это понадобиться. Для этого вы должны указать флаг MEM_RELEASE (но не MEM_DECOMMIT) при вызове {VirtualFree}.

* Приложения, которые используют AWE, не могут выполняться в режиме эмуляции. Поэтому те приложения, на архитектуре x86, которые используют AWE, должны быть перекомпилированы на других процессорах, тогда как другие большинство других приложений может быть запущено на других платформах в режиме эмуляции.

Решение адресовать физическую память следует в большей степени из получаемых при этом выгод. Вот некоторые выгоды использования AWE:

* Небольшое число функций, использующихся для операий с AWE памятью.

* AWE поддерживается на всех платформах, на которых реализована Windows 2000, включая 64-х битную версию Windows 2000.

* AWE предоставляет очень быстрое перераспределение хранимых данных. Перераспределение осуществляется путем использования таблиц виртуальной памяти без перемещеня данных в физической памяти.

* Гранулярность размера AWE страницы соответствует типу процессора (для архитектуры x86 это 4 Кб) которые более полезны для приложений, чем большие страницы (например, 2 Мб, 4 Мб на x86).

Для того чтобы получить привелегию фиксирования страниц в памяти, администратор должен добавить значение атрибута "Lock Page in Memory" в правах пользователя. Установить этот параметр можно выбрав "Панель управления &rArr; Администрирование &rArr; Локальная политика безопасности &rArr; Локальная политика &rArr; Назначение прав пользователя &rArr; Закрепление страниц в памяти" (Control panel &rArr; Administrative tools &rArr; Local security policy &rArr; Local policy &rArr; User right assigment &rArr; Lock pages in memory). Для более детальной информации по этому вопросу смотрите раздел "Права пользователей" в справочной системе по Windows 2000.

Следующие функции реализуют API расширения адресной оболочки Windows (AWE API):

VirtualAlloc - Резервирует диапазон виртуального адресного пространства для использования под AWE (атрибут MEM_PHYSICAL).

AllocateUserPhysicalPages - Выделяет физическую память для использования с AWE.

MapUserPhysicalPages - Проецирует (или сводит на нет) виртуальное пространство AWE на произвольный набор физических страниц, полученных при помощи вызова AllocateUserPhysicalPages.

MapUserPhysicalPagesScatter - Проецирует (или сводит на нет) виртуальное пространство AWE на произвольный набор физических страниц, полученных при помощи вызова AllocateUserPhysicalPages, позволяющей организовать сложное проецирование.

FreeUserPhysicalPages - Освобождает физическую память, которая была выделена под AWE.

© Mystic, 2002.

Как установить компонент от другой версии, если имеется только .DCU файл?

Никак. DCU файлы разных версий Дельфи несовместимы. Нужны либо исходники компонентов, либо надо просить у разработчика компиляцию для текущей версии Дельфи.

©Drkb::00351.

Не получается открыть таблицу (WIN1251 undefined).

Не получается открыть таблицу, созданную в InterBase с DEFAULT CHARACTER SET WIN1251. Оно говорит, что "WIN1251 undefined".

Ставьте Interbase в каталог с путем, соответствующим DOS-овским соглашениям об именах (8+3).

Copyright (C) Alexey Mahotkin 1997-1999.

©Drkb::02928.

После логина возникает EExternalError 0xC0000008.

Windows 4.0 + Delphi 2.01 C/S + Oracle Client 7.3 + Oracle Server 7.3. После логина в базу данных возникает "EExternalError 0xC0000008". Что делать?

Снести Oracle Trace Collection Services.

Copyright (C) Alexey Mahotkin 1997-1999.

©Drkb::02735.

Мигание при добавлении строк.

При добавлении большого количества строк происходит мигание компонента.

Code: Combobox1.BeginUpdate; //здесь вставляем строки. Combobox1.EndUpdate;

Как ограничить перемещение курсора?

Как ограничить перемещение курсора мыши какой-либо областью экрана?

ClipCursor().

Учтите, что использование этой функции - плохой тон.

Copyright (C) Alexey Mahotkin 1997-1999.

©Drkb::02329.

Создание модулей расширения Microsoft Office.

Анатолий Тенцер.

Модель модулей расширения Microsoft Office 2000.

В Office 2000 Microsoft ввела единый API для написания подключаемых модулей, расширяющих функциональные возможности пакета. Теперь стало возможно написание модулей, которые интегрируются с любым из приложений пакета. Разработанный набор интерфейсов упрощает создание расширений, позволяя программисту сконцентрироваться на функциональности, а не на изучении особенности каждого из приложений.

Новая модель подключаемых модулей была названа COM Add-Ins. Как следует из названия, модуль расширения (Add-In) представляет собой COM-сервер, который специальным образом зарегистрирован в операционной системе. При загрузке приложение пакета Office загружает зарегистрированные расширения и вызывает их методы, позволяя установить обработчики на необходимые для их дальнейшего функционирования события. По завершении работы приложение Office извещает об этом модули расширения, позволяя последним корректно освобождать ресурсы.

Общение модулей расширения с загрузившим их приложением происходит с помощью объектной модели Microsoft Office.

Использование COM Add-In позволяет в корне изменить подходы к интеграции приложений с Microsoft Office. Например, вместо того чтобы вызывать Word для генерации отчетов, можно, наоборот, встроить в него меню со списком отчетов, а по выбору пользователем нужного отчета — запросить данные из базы данных и сформировать по ним документ.

Интерфейс IDTExtensibility2.

Ключевым моментом в написании COM Add-In является реализация им интерфейса IDTExtensibility2, определенного следующим образом:

Code: Type. IDTExtensibility2 = interface(IDispatch). ['{B65AD801-ABAF-11D0-BB8B-00A0C90F2744}']. Procedure OnConnection(const HostApp: IDispatch; Ext_ConnectMode: Integer; const AddInInst: IDispatch; Var custom: PSafeArray); safecall; Procedure OnDisconnection(ext_DisconnectMode: Integer; Var custom: PSafeArray); safecall; Procedure OnAddInsUpdate(var custom: PSafeArray); safecall; Procedure OnStartupComplete(var custom: PSafeArray); safecall; Procedure BeginShutdown(var custom: PSafeArray); safecall; End;

Естественные ключи против искуственных ключей.

Естественные ключи против искуственных ключей.

Автор: Анатолий Тенцер, статья 6-20 июля 1999 года, версия 1.1.

Данная статья излагает взгляд автора на проблему, регулярно обсуждающуюся в группах новостей, посвящённых разработке приложений с использованием РСУБД.

О сущности проблемы.

Каждая запись в таблице, входящей в РСУБД, должна иметь первичный ключ (ПК) - набор атрибутов, уникально идентифицирующий её в таблице. Случай, когда таблица не имеет первичного ключа, имеет право на существование, однако в данной статье не рассматривается.

В качестве первичного ключа может использоваться -

Естественный Ключ (ЕК) - набор атрибутов описываемой записью сущности, уникально её идентифицирующий (например, номер паспорта для человека);

Или.

Суррогатный Ключ (СК) - автоматически сгенерированное поле, никак не связанное с информационным содержанием записи. Обычно в роли СК выступает автоинкрементное поле типа INTEGER.

Есть два мнения:

• СК должны использоваться, только если ЕК не существует. Если же ЕК существует, то идентификация записи внутри БД осуществляется по имеющемуся ЕК;

• СК должны добавляться в любую таблицу, на которую существуют ссылки (REFERENCES) из других таблиц, и связи между ними должны организовываться только при помощи СК. Разумеется, поиск записи и представление её пользователю по прежнему производятся на основании ЕК.

Естественно, можно представить себе и некое промежуточное мнение, но сейчас дискуссия ведётся в рамках двух вышеизложенных.

Когда появляются СК.

Для понимания места и значения СК рассмотрим этап проектирования, на котором они вводятся в структуру БД, и методику их введения.

Для ясности рассмотрим БД из 2-х отношений - Города (City) и Люди (People) Предполагаем, что город характеризуется Названием (Name), все города имеют разные названия, человек характеризуется Фамилией (Family), номером паспорта (Passport) и городом проживания (City). Также полагаем, что каждый человек имеет уникальный номер паспорта. На этапе составления инфологической модели БД её структура одинакова и для ЕК и для СК.

Code: CREATE TABLE City( Name VARCHAR(30) NOT NULL PRIMARY KEY. ); CREATE TABLE People( Passport CHAR(9) NOT NULL PRIMARY KEY, Family VARCHAR(20) NOT NULL, City VARCHAR(30) NOT NULL REFERENCES City(Name). );

Delphi и COM (статья).

Создание Plug-In в виде COM-СервераВведение и базовые понятия.

Реализация интерфейсов.

Интерфейсы и TComponent.

COM-сервер, структура и использование.

Создание COM-сервера.

Создание приложения клиента.

Создание Plug-In в виде COM-Сервера.

Автоматическая регистрация серверов из своей программы.

OLE Automation.

Тенцер А. Л.

ICQ UIN 15925834.

Tolik@katren.nsk.ru.

©Drkb::04317.

Введение и базовые понятия.

Delphi и COM.

Введение.

COM (Component Object Model) или модель объектных компонентов – одна из основных технологий, на который основывается Windows. Более того, все новые технологии в Windows (Shell, Scripting, поддержка HTML и т.п.) реализуют свои API именно в виде COM интерфейсов. Таким образом, в настоящее время профессиональное программирование требует понимания модели COM и умения с ней работать. В этой главе мы рассмотрим основные понятия COM и особенности их поддержки в Delphi.

Базовые понятия.

Основным понятием, на котором основана модель COM, является понятие интерфейса. Не имея четкого понимания о том, что такое интерфейс невозможно успешное программирование COM-объектов. Главными понятиями являются интерфейс и реализация интерфейса.

Интерфейс.

Интерфейс является контрактом, между программистом и компилятором.

Программист – обязуется реализовать все методы, описанные в интерфейсе и следовать требованиям на реализацию некоторых их них.

Компилятор – обязуется создать в программе внутренние структуры, позволяющие обращаться к методам этого интерфейса из любого поддерживающего те же соглашения средства программирования. Таким образом, COM является языково-независимой технологией и может использоваться в качестве «клея», соединяющего программы, написанные на разных языках.

Объявление интерфейса включает в себя описание методов и их параметров, но не включает их реализации. Кроме этого, в объявлении может указываться идентификатор интерфейса – уникальное 16-байтовое число, сгенерированное по специальным правилам, гарантирующим его статистическую уникальность (GUID – global unique identifier).

Интерфейсы могут наследоваться. Наследование интерфейсов – это декларация, указывающая, что унаследованный интерфейс должен включать в себя все методы предка.

Таким образом, необходимо понимать, что:

Интерфейс – это не класс.

Класс может выступать реализацией интерфейса, но класс содержит код методов на конкретном языке программирования, а интерфейс – нет.

Интерфейс строго типизирован.

Как клиент, так и реализация интерфейса должны использовать точно те же методы и параметры, как указано в описании интерфейса.

Интерфейс является неизменным контрактом.

Вы не должны определять новой версии того же интерфейса с измененным набором методов (или их параметров), но с тем же идентификатором. Это гарантирует, что новые интерфейсы никогда не конфликтуют со старыми. Если Вы нуждаетесь в расширении функциональности, Вы должны определить новый интерфейс, возможно являющийся наследником старого и реализовать дополнительные методы в нем.

Реализация интерфейса – это непосредственно код, который реализует эти методы. При этом за несколькими исключениями, не накладывается никаких ограничений на то, каким образом будет выглядеть реализация. Физически реализация представляет собой массив указателей на методы, адрес которого и используется в клиенте для доступа к COM-объекту. Любая реализация интерфейса имеет метод QueryInterface, позволяющий запросить ссылку на конкретный интерфейс из числа реализуемых.

Автоматическое управление памятью и подсчет ссылок.

Кроме предоставления независимого от языка программирования доступа к методам объектов COM реализует автоматическое управление памятью для COM-объектов. Оно основано на идее подсчета ссылок на объект. Любой клиент, желающий использовать COM объект после его создания должен вызвать заранее предопределенный метод, который увеличивает внутренний счетчик ссылок на объект на единицу. По завершении использования объекта клиент вызывает другой его метод, уменьшающий значение этого же счетчика. При достижении счетчиком ссылок нулевого значения COM-объект автоматически удаляет себя из памяти. Такая модель позволяет клиентам не вдаваться в подробности реализации объекта, а объекту – обслуживать несколько клиентов и корректно очистить память по завершении работы с последним из них.

Объявление интерфейсов.

Для поддержки интерфейсов Delphi расширяет синтаксис языка Pascal дополнительными ключевыми словами. Объявление интерфейса в Delphi реализуется ключевым словом interface.

Code: Type. IMyInterface = interface. ['{412AFF00-5C21-11D4-84DD-C8393F763A13}']. Procedure DoSomething(var I: Integer); stdcall; Function DoSomethingAnother(S: String): Boolean; End; IMyInterface2 = interface(IMyInterface). ['{412AFF01-5C21-11D4-84DD-C8393F763A13}']. Procedure DoAdditional(var I: Integer); stdcall; End;

Реализация интерфейсов.

Реализацией интерфейса в Delphi всегда выступает класс. Для этого в объявлении класса необходимо указать, какие интерфейсы он реализует.

Code: Type. TMyClass = class(TComponent, IMyInterface, IDropTarget). // Реализация методов. End;

Интерфейсы и TComponent.

В базовом классе VCL TComponent имеется полный набор методов, позволяющих реализовать интерфейс IUnknown, хотя сам класс не реализует этого интерфейса. Это позволяет наследникам TComponent реализовывать интерфейсы не заботясь о реализации IUnknown. Однако, методы TComponent._AddRef и TComponent._Release на этапе выполнения программы не реализуют механизма подсчета ссылок, и, соответственно, для классов-наследников TComponent, реализующих интерфейсы не действует автоматическое управление памятью. Это позволяет запрашивать у них интерфейсы не опасаясь, что объект будет удален из памяти при выходе переменной за область видимости. Таким образом, следующий код совершенно корректен и безопасен:

Code: Type. IGetData = interface. ['{B5266AE0-5E77-11D4-84DD-9153115ABFC3}']. Function GetData: String; End; TForm1 = class(TForm, IGetData). Private. Function GetData: String; End; … Var. I: Integer; GD: IGetData; S: String; Begin. S := ''; For I := 0 to Pred(Screen.FormCount) do begin. If Screen.Forms[I].GetInterface(IGetData, GD) then. S := S + GD.GetData + #13; End; ShowMessage(S); End;

COM-сервер, структура и использование.

COM-сервер, структура и использование.

Модель COM предоставляет возможность создания многократно используемых компонентов, независимых от языка программирования. Такие компоненты называются COM-серверами и представляют собой исполнимые файлы (EXE) или динамические библиотеки (DLL), специальным образом оформленные для обеспечения возможности их универсального вызова из любой программы, написанной на поддерживающем COM языке программирования. При этом COM сервер может выполняться как в адресном пространстве вызывающей программы (In-Proc сервер), так и в виде самостоятельного процесса (Out-Of-Proc сервер) или даже на другом компьютере (Distributed COM). COM автоматически разрешает вопросы, связанные с передачей параметров (Marshalling) и согласованием потоковых моделей клиента и сервера.

Далее будут рассмотрены некоторые архитектурные вопросы, знание которых необходимо для работы с COM.

COM-сервер.

COM-сервер – это специальным образом оформленное и зарегистрированное приложение, которое позволяет клиентам запрашивать у себя создание реализованных в нем объектов. Сервер может быть выполнен в виде динамической библиотеки, либо исполнимого файла.

Сервер в виде DLL.

Такой сервер всегда выполняется в адресном пространстве активизировавшего его приложения (In-Process). За счет этого, как правило, снижаются накладные расходы на вызов методов сервера. В то же время такой сервер менее надежен, поскольку его память не защищена от ошибок в вызывающем приложении. Кроме этого он не может выполняться на удаленной машине без исполнимого модуля-посредника, который бы создал процесс, в который может быть загружена DLL. Примером такого модуля может служить Microsoft Transaction Server.

Сервер в виде исполнимого файла.

Этот сервер представляет собой обычный исполнимый файл Windows в котором реализована возможность создания COM-объектов по запросу других приложений. Примером такого сервера является пакет Microsoft Office, приложения которого являются COM-серверами.

Регистрация сервера.

COM реализует механизм автоматического поиска серверов по запросу клиента. Каждый COM-объект имеет уникальный идентификатор, Class Identifier (CLSID). Windows ведет в реестре базу данных зарегистрированный объектов, индексированную при помощи CLSID. Она расположена в ветке реестра HKEY_CLASSES_ROOT\CLSID.

Для каждого сервера прописывается информация, необходимая для нахождения и загрузки его модуля. Таким образом, клиентское приложение не должно беспокоиться о поиске сервера, достаточно зарегистрировать его на компьютере и COM автоматически найдет и загрузит нужный модуль. Кроме этого, объект может зарегистрировать свое «дружественное» имя, или Programmatic Identifier (PROGID). Обычно оно формируется как комбинация имени сервера и имени объекта, например «Word.Application». Это имя содержит ссылку на CLSID объекта. Когда он создается с использованием PROGID – COM просто берет связанное с ним значение CLSID и получает из него всю необходимую информацию.

Серверы в виде EXE автоматически регистрируются при первом запуске программы на компьютере. Для регистрации серверов DLL служит программа Regsvr32, поставляемая в составе Windows, либо TRegSvr из поставки DELPHI.

Потоки и Комнаты.

Windows – многозадачная и многопоточная среда с вытесняющей многозадачностью. Применительно к COM это обозначает, что клиент и сервер могут оказаться в различных процессах или потоках приложения, что к серверу могут обращаться множество клиентов, причем в непредсказуемые моменты времени. Технология COM решает эту проблему при помощи концепции комнат (Apartments), в которых и выполняются COM клиенты и серверы. Комнаты бывают однопоточные (Single Threaded Apartment, STA) и многопоточные (Multiple Threaded Apartment, MTA).

STA.

При создании однопоточной «комнаты» COM неявно создает окно, и при вызове любого метода COM-сервера в этой «комнате» посылает этому окну сообщение при помощи функции PostMessage. Таким образом, организуется очередь вызовов методов и каждый из них обрабатывается только после того, как будут обработаны все предшествующие вызовы. Основные достоинства однопоточной «комнаты»:

1. Программист может не заботиться о синхронизации методов. Гарантируется, что до окончания выполнения текущего метода не будет вызван никакой другой метод объекта.

2. Программист может не заботиться о синхронизации доступа к полям класса, реализующего объект. Поскольку одновременно может выполняться только один метод – одновременный доступ к полю из двух методов невозможен.

В то же время, если приложение создало несколько потоков, в каждом из которых имеется STA – при доступе к глобальным разделяемым данным они должны использовать синхронизацию, например при помощи критических секций.

Недостатки STA напрямую вытекают из её реализации:

1. Дополнительные (и иногда излишние) затраты на синхронизацию при вызове методов.

2. Невозможность отклика на вызов метода, пока не исполнен предыдущий. Например, если в настоящее время выполняется метод, требующий одну минуту на исполнение – то до его завершения COM-объект будет недоступен.

Тем не менее, STA как правило является наиболее подходящим выбором для реализации COM-сервера. Использовать MTA есть смысл только в том случае, если STA не подходит для конкретного сервера.

MTA.

Многопоточная «комната» не реализует автоматического сервиса по синхронизации и не имеет его ограничений. Внутри неё может быть создано сколько угодно потоков и объектов, причем каждый объект не привязан к какому-то конкретному потоку. Это означает, что любой метод объекта может быть вызван в любом из потоков в MTA. В это же самое время в другом потоке может быть вызван любой другой (либо тот же самый) метод COM-объекта по запросу другого клиента. COM автоматически ведет пул потоков внутри MTA и, при вызове со стороны клиента, находит свободный поток, и в нем вызывает метод требуемого объекта. Таким образом, даже если выполняется метод, требующий длительного времени – для другого клиента он может быть вызван без задержки в другом потоке. Очевидно, что COM-сервер, работающий в MTA обладает потенциально более высоким быстродействием и доступностью для клиентов, однако он значительно сложнее в разработке, поскольку даже локальные данные объектов не защищены от одновременного доступа и требуют синхронизации.

Передача интерфейсов и параметров.

Таким образом, клиент и сервер COM могут выполняться как в одной «комнате», так и в разных, расположенных в различных процессах или даже на разных компьютерах. Встает вопрос – как же клиент может вызывать методы сервера, если они находятся в общем случае в другом адресном пространстве?

Эту работу берет на себя COM. Для доступа к серверу в другой «комнате» клиент должен запросить у COM создание в своей «комнате» представителя, реализующего запрошенный интерфейс. Такой представитель в терминах COM называется proxy и представляет собой объект, экспортирующий запрошенный интерфейс. Одновременно, COM создает в «комнате» сервера объект-заглушку, принимающий вызовы от proxy и транслирующий их в вызовы сервера. Таким образом, клиент в своей комнате может рассматривать proxy в качестве сервера и работать с ним так, как будто сервер создан в его «комнате». В то же время, сервер может рассматривать stub как расположенного с ним в одной «комнате» клиента. Всю работу по организации взаимодействия proxy и stub берет на себя COM. При вызове со стороны клиента Proxy получает от него параметры, упаковывает их во внутреннюю структуру и передает в комнату сервера. Stub получает параметры, распаковывает их и производит вызов метода сервера. Аналогично осуществляется передача параметров обратно. Этот процесс называется Marshalling. При этом «комнаты» клиента и сервера могут иметь разные потоковые модели и физически находиться где угодно. Разумеется, такой вызов вносит значительные накладные расходы, по сравнению с вызовом сервера в «своей» комнате, однако это единственный способ обеспечить корректную работу любых клиентов и серверов. Если необходимо избежать накладных расходов – сервер надо создавать в той же комнате, где расположен клиент.

Для обеспечения возможности корректного создания Proxy в клиентской комнате COM должен узнать «устройство» сервера. Сделать это можно двумя способами:

1. Реализовать на сервере интерфейс IMarshal и, при необходимости proxy-DLL, которая будет загружена на клиенте для реализации proxy. Подробности реализации описаны в документации COM и MSDN

2. Описать интерфейс на IDL (Interface Definition Language) и при помощи компилятора MIDL фирмы Microsoft сгенерировать proxy-stub DLL

3. Сделать сервер совместимым с Ole Automation. В этом случае COM сам создаст proxy, используя описание сервера из его библиотеки типов – специального двоичного ресурса, описывающего COM-интерфейс. При этом в интерфейсе можно использовать только типы данных, совместимые с Ole Automation.

4.

Инициализация COM.

Каким же образом клиенты и серверы COM могут создавать комнаты в соответствии со своими требованиями? Для этого они должны соблюдать одно правило: каждый поток, который желает использовать COM должен создать комнату, при помощи вызова функции CoInitializeEx. Она объявлена в модуле ActiveX.pas следующим образом:

Code: Const. COINIT_MULTITHREADED = 0; // OLE calls objects on any thread. COINIT_APARTMENTTHREADED = 2; // Apartment model. Function CoInitializeEx(pvReserved: Pointer; CoInit: Longint): HResult; stdcall;

Создание COM-сервера.

Для создания COM-сервера Delphi предоставляет широкий набор мастеров, автоматизирующих выполнение рутинных задач и позволяющих программисту сконцентрироваться на реализации функциональности. Мастера доступны при помощи команды меню File->New, на закладке ActiveX.

Чтобы сделать COM-сервером EXE-файл, Вы должны просто добавить в него модуль с COM-объектом. Для создания COM-сервера в виде DLL Вы должны сначала создать библиотеку, оформленную с учетом требований COM. Это делается при помощи мастера «ActiveX Library». При его выборе будет создан новый проект, реализующий DLL и сгенерирован следующий код:

Code: Library Project1; Uses. ComServ; Exports. DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; {$R *.RES}. Begin. End.

OLE Automation.

Стандарт COM основан на едином для всех поддерживающих его языков формате таблицы, описывающей ссылки на методы объекта, реализующего интерфейс. Однако, вызов методов при помощи этой таблицы доступен только для компилирующих языков программирования. В то же время, очень удобно было бы иметь доступ к богатству возможностей, предоставляемых COM из интерпретирующих языков, таких, как VBScript. Для поддержки этих языков была разработана технология под названием OLE Automation, позволяющая приложениям делать свою функциональность доступной для гораздо большего числа клиентов. Automation базируется на COM и является его подмножеством, однако накладывает на COM-серверы ряд дополнительных требований:

1. Интерфейс, реализуемый COM-сервером должен наследоваться от IDispatch

2. Должны использоваться типы данных, из числа поддерживаемых OLE Automation

Тип данных OLE Automation Тип данных Delphi Примечание.

Boolean WordBool.

Unsigned Char Byte.

Double Double.

Float Single.

Int SYSINT Машинно-зависимый целый тип данных, в настоящее время объявлен как Integer, однако, в будущем может иметь другую разрядность.

Long Integer.

Short SmallInt.

BSTR WideString В Automation нельзя использовать строки Delphi.

Currency Currency.

Date TDateTime.

SAFEARRAY PSafeArray Массив из элементов любого поддерживаемого типа.

Decimal TDecimal 96 битное десятичное число.

Interface IDispatch * IDispatch Ссылка на IDispatch или любой унаследованный от него интерфейс.

Interface IUnknown * IUnknown Ссылка на произвольный интерфейс.

VARIANT OleVariant Вариант, совместимый с OLE.

Возможна поддержка пользовательских типов данных, для чего необходимо реализовать интерфейс IRecordInfo.

1. Все методы должны быть процедурами или функциями, возвращающими значение типа HRESULT

2. Все методы должны иметь соглашение о вызовах safecall

Кроме этого, Automation-серверы могут поддерживать еще ряд интерфейсов, позволяющих получать информацию о методах, обрабатывать ошибки и т.п. Все необходимые интерфейсы реализуются VCL Delphi автоматически.

IDispatch.

Центральным элементом технологии OLE Automation является интерфейс IDispatch. Ключевыми методами этого интерфейса являются методы GetIdsOfNames и Invoke, которые позволяют клиенту запросить у сервера, поддерживает ли он метод с указанным именем, а затем, если метод поддерживается – вызвать его. Подробно реализация и работа IDispatch рассматривается в главе, посвященной работе с Mcrosoft Scripting Control, здесь же мы лишь вкратце опишем основной алгоритм вызова методов при помощи IDispatch.

Когда клиенту требуется вызвать метод, он вызывает GetIdsOfNames, передавая ему имя запрошенного метода. Если сервер поддерживает такой метод, он возвращает его идентификатор – целое число, уникальное для каждого метода. После этого клиент упаковывает параметры в массив переменных типа OleVariant и вызывает Invoke, передавая ему массив параметров и идентификатор метода.

Таким образом, все, что должен знать клиент – это строковое имя метода. Такой алгоритм позволяет работать с наследниками IDispatch из скриптовых языков.

Методы GetTypeInfo и GetTypeInfoCount являются вспомогательными и обеспечивают поддержку библиотеки типов объекта. Реализация методов GetIdsOfNames и Invoke, предоставляемая COM по умолчанию базируется на библиотеке типов объекта.

Поддержка IDispatch, тип данных Variant.

Delphi имеет встроенную поддержку работы в качестве клиента Automation. Тип данных Variant может содержать ссылку на интерфейс IDispatch и использоваться для вызова его методов.

Code: Uses ComObj; Procedure TForm1.Button1Click(Sender: TObject); Var. V: Variant; Begin. V := CreateOleObject('InternetExplorer.Application'); V.Toolbar := FALSE; V.Left := (Screen.Width - 600) div 2; V.Width := 600; V.Top := (Screen.Height - 400) div 2; V.Height := 400; V.Visible := TRUE; V.Navigate(URL := 'file://C:\config.sys'); V.StatusText := V.LocationURL; Sleep(10000); V.Quit; End;

Создание приложения клиента.

Перейдем к написанию приложения клиента. Если у нас есть модуль Project_TLB, то оно ничем не будет отличаться от предыдущего примера. Более интересен случай, когда мы имеем только исполнимый файл с сервером. Зарегистрируем этот сервер и выберем в меню Delphi IDE команду Project -> Import Type Library.

В открывшемся окне найдем строку с описанием библиотеки типов требуемого сервера:

Если включен флажок Generate Component Wrappers, то в импортированный модуль будет добавлен код для создания компонента Delphi, который можно бросить на форму и он автоматически создаст требуемый COM-сервер и позволит обращаться к его методам. В противном случае будет сгенерирован модуль, содержащий описание всех имеющихся в библиотеке типов интерфейсов.

Далее Вы должны определить, что Вы собираетесь сделать с выбранной библиотекой.

Install Создает модуль с описанием интерфейсов и автоматически регистрирует требуемые компоненты в IDE. После этого Вам остается лишь бросить их на форму.

Create Unit Создает интерфейсный модуль, но не устанавливает его в IDE. Это удобно, если Вам нужны только описания интерфейсов, либо если Вы хотите вручную установить его в package, отличающуюся от используемой по умолчанию.

Таким образом, для распространения и использования сервера не нужно ничего, кроме его исполнимого модуля. Но самое главное даже не это. Гораздо более важно, что Вы можете импортировать и использовать в своей программе любой из имеющихся на компьютере COM-серверов. Естественно, что при передаче своей программы клиенту Вы должны установить на его компьютере соответствующий COM-сервер.

Для примера, используем в своем приложении процессор регулярных выражений VBScript. Импортируем библиотеку типов «Microsoft VBScript Regular Expressions».

При этом будет создан файл VBScript_RegExp_TLB.pas.

Создадим форму и добавим следующий код для проверки вхождения текста в Exit1 в текст Edit2:

Code: Uses. VBScript_RegExp_TLB; Procedure TForm1.Button1Click(Sender: TObject); Var. RE: IRegExp; Begin. RE := CoRegExp.Create; RE.Pattern := Edit1.Text; If RE.Test(Edit2.Text) then. Caption := 'TRUE' Else. Caption := 'FALSE'; End;

Создание Plug-In в виде COM-Сервера.

Попробуем теперь реализовать Plug-In к своей программе, в виде COM-сервера и сравним код, полученный в этом случае с кодом, полученным при «ручном» программировании. В начале создадим модуль с описанием интерфейсов:

Code: Unit PluginInterface; Interface. Const. Class_TAPI: TGUID = '{A132D1A1-721C-11D4-84DD-E2DEF6359A17}'; Type. IAPI = interface. ['{64CFF1E0-61A3-11D4-84DD-B18D6F94141F}']. Procedure ShowMessage(const S: String); End; ILoadFilter = interface. ['{64CFF1E1-61A3-11D4-84DD-B18D6F94141F}']. Procedure Init(const FileName: String); Function GetNextLine(var S: String): Boolean; End; Implementation. End.

Автоматическая регистрация серверов из своей программы.

Удобно в своей программе автоматически регистрировать все необходимые серверы. Это можно сделать при помощи следующей процедуры:

Code: Procedure CheckComServerInstalled(const CLSID: TGUID; const DllName: String); Var. Size: Integer; DllHandle: THandle; FileName: String; Begin. Size := MAX_PATH; SetLength(FileName, Size); Try. If RegQueryValue(HKEY_CLASSES_ROOT, PChar(Format('CLSID\%s\InProcServer32', [GUIDToString(CLSID)])), PChar(FileName), Size) = ERROR_SUCCESS then. Begin. SetLength(FileName, Size); DllHandle := LoadLibrary(PChar(FileName)); FreeLibrary(DllHandle); If DllHandle = 0 then begin. RegDeleteKey(HKEY_CLASSES_ROOT, PChar(Format('CLSID\%s',[GUIDToString(CLSID)]))); RegisterComServer(DllName); End; End else begin. RegisterComServer(DllName); End; Except. Raise Exception.CreateFmt('Не могу зарегистрировать %s.', [DllName]); End; End;

Delphi и Windows API (Статья).

Одной из наиболее интересных особенностей Delphi является предоставление, наряду с высокоуровневыми функциями VCL, простого доступа к функциям Windows API. Программист в любой момент волен, в зависимости от стоящей перед ним задачи, выбрать для её решения простые в использовании компоненты, либо реализовать алгоритм, требующий компактности и быстродействия при помощи прямых вызовов API. Более того, как правило, можно не прекращая использовать компоненты и визуальное программирование нанести несколько штрихов при помощи API и добиться максимальной точности решения задачи и быстродействия.

Windows – окна и сообщения.

Окна.

Само название операционной системы Windows говорит, что основным её элементом является окно. Для успешного программирования разработчик должен четко представлять себе, что подразумевается в Windows под этим понятием.

Для начинающих программистов не очевидно, что окнами Windows являются не только главные окна, но и большинство элементов управления в них, таких как поля ввода, списки, кнопки и т.п. Фактически, любой элемент интерфейса, способный получать фокус ввода является окном Windows. Окна могут иметь окно-владельца (Parent window). В этом случае они называются дочерним окном (Child Window) и располагаются на поверхности владельца.

Класс окна.

Поведение окна и его внешний вид определяются классом окна. Класс – это внутренняя структура Windows, описывающая шаблон, на основании которого операционная система создает окна. Перед созданием окна Вы должны зарегистрировать его класс при помощи функции:

Code: Function RegisterClassEx( Const WndClass: TWndClassEx. ): ATOM; stdcall;

Interprocess communication на примере keyboard hook (статья).

Взаимодействие процессов.

Архитектура Win32 подразумевает максимальную изоляцию выполняющихся приложений друг от друга. Каждое приложение выполняется в своем виртуальном адресном пространстве, которое полностью обособлено и не имеет доступа к памяти других программ. Однако иногда возникает необходимость в передаче данных их одного выполняющегося процесса в другой. Рассмотрим подробно одну из таких задач, а затем основные способы связи между процессами и рекомендации по их применению.

Пишем перехватчик клавиатуры.

Итак, стоит задача – перехватить события от клавиатуры во всех выполняющихся процессах. Для перехвата событий Win32 API предоставляет механизм, называемый «ловушками» (hook). Ловушка может быть установлена на многие события, возникающие в Windows, такие, как события от мыши, создание окон, вызов оконной процедуры и т.п. Для её установки используется функция:

Function SetWindowsHookEx(

IdHook: Integer; // Идентификатор, показывающий какая.

// ловушка устанавливается.

Lpfn: TFNHookProc; // Адрес функции-ловушки.

Hmod: HINST; // Идентификатор модуля, в котором находится.

// процедура-ловушка.

DwThreadId: DWORD // Идентификатор потока, для которого ловушка.

// устанавливается.

): HHOOK; stdcall; // Функция возвращает идентификатор ловушки.

Рассмотрим эти параметры подробнее:

IdHook Целое число, инструктирующее Windows какое событие должно вызывать срабатывание «ловушки». Должно быть одной из констант, WH_XXX, описанных в Windows.pas. Нас интересует WH_KEYBOARD.

LpFn Адрес функции, которая будет автоматически вызываться каждый раз при возникновении события.

HMod Идентификатор модуля, в котором расположена функция. Если ловушка устанавливается на события, происходящие в других процессах (а не только в вызывающем), то функция lpfn должна находиться в DLL. Эта DLL загружается в адресное пространство каждого процесса Windows. Если ловушка ставится только на события, происходящие в вызывающем процессе, то функция может находиться прямо в EXE файле, а в качестве этого параметра передается 0.

DwThreadId Идентификатор потока, события в котором нас интересуют. Если этот параметр равен 0, то ловушка ставится на все потоки в системе.

Поскольку нам нужны события во всех потоках – необходимо написать DLL, содержащую функцию-ловушку. В эту же DLL удобно поместить функцию для включения и отключения ловушки.

Функция-ловушка для WH_KEYBOARD должна соответствовать прототипу:

Function KeyboardProc(

Code: Integer; // Определяет способ обработки события.

// если Code < 0, функция должна немедленно.

// вызвать CallNextHookEx и возвратить.

// её результат.

WParam: WPARAM; // Содержит код клавиши.

LParam: LPARAM // Содержит набор битовых флагов с дополнительной.

// информацией.

): Integer; // Функция должна вернуть 0 для разрешения Windows.

// дальнейшей обработки события или другое число.

// для её запрета.

Stdcall; // Функция должна соответствовать соглашению о.

// вызовах stdcall.

В простейшем случае функция должна содержать следующий код:

Code: Function KeyboardProc(Code: Integer; wParam: WPARAM; LParam: LPARAM): Integer; stdcall; Begin. If Code < 0 then. Result := CallNextHookEx(HookHandle, Code, wParam, lParam ); End;

Особенности работы с БД на MS SQL Server 2000 из Delphi 5 (статья).

Обзор сервера.

Особенности реализации клиентской части.

· Особенности реализации серверной части

· SELECT

· INSERT, UPDATE и DELETE

· CREATE TABLE и типы данных

· Написание триггеров

· Пакеты команд

· Обработка ошибок

· Блокировки

· Обработка транзакций

· Соответствие стандарту ANSI SQL 92

· Модель безопасности

· Оптимизатор запросов MS SQL Server

· Получение уникальных идентификаторов

· Временные таблицы

· Создание хранимых процедур и триггеров

· Кластерные индексы

· Определяемые пользователем функции

Советы по работе с MS SQL Server.

Тенцер А. Л.

ICQ UIN 15925834.

Tolik@katren.nsk.ru.

©Drkb::02776.

Обзор сервера.

Обзор сервера.

MS SQL Server – прямой потомок Sybase SQL Server, с которым их до сих пор связывает много общего, в первую очередь язык программирования Transact-SQL (далее T-SQL). Однако, в версии 7.0 Microsoft, по её собственным утверждениям, переписала сервер полностью, так что он больше не содержит кода от Sybase. Главным достоинством MS SQL Server является тесная интеграция с Windows NT и семейством продуктов Back Office – общая модель защиты, базирующаяся на защите Windows NT, единая консоль администрирования (Microsoft Management Console), единый набор программных интерфейсов для доступа к данным (OLE DB). Текущая версия сервера на момент написания этой книги – Microsoft SQL Server 2000. Сервер выпускается в следующих редакциях:

• Personal – версия, работающая на Windows 95 и Windows NT Workstation. Предназначена в основном для отладки при разработке ПО. Поддерживает до 2 процессоров. Реально можно работать (имея загруженным сервер, Query Analyzer и Enterprise Manager) на конфигурации P100/40 Мб под Windows 95.

• Standard – стандартная редакция. Работает под Windows NT Server. Поддерживает до 4 процессоров.

• Enterprise – расширенная редакция. Поддерживает до 32 процессоров, включает в себя некоторые дополнительные возможности.

• Developer – редакция для разработчиков. По функциональности примерно соответствует Enterprise

Кроме этого существует версия SQL Server для Windows CE, предназначенная для портативных компьютеров. Эта версия совместима с остальными версиями сервера по языку и имеет возможности репликации данных с ними.

Таким образом, сервер работает на всей линейке операционных систем Microsoft на процессорах Intel и Alpha.

Также нельзя не упомянуть такой продукт, как Microsoft Data Engine (MSDE) – версия MS SQL Server без графических средств администрирования и с ограничениями по размеру БД (2Гб) и количеству пользователей (5). Эта версия предназначена для построения встраиваемых систем, которые при необходимости легко могут быть портированы на полнофункциональную редакцию сервера, а также, например, для создания демонстрационных версий продуктов. Администрирование MSDE может производиться при помощи утилиты osql, клиентских утилит от MS SQL Server, либо из MS Access 2000. MSDE поставляется в составе MS Office 2000 Professional и MS Visual Studio.

Из дополнительных возможностей следует отметить:

• OLAP сервер – средство для создания и представления многомерных кубов данных, использующихся в аналитических системах. На настоящий момент MS SQL является одним из самых дешевых имеющихся на рынке решений подобного рода. OLAP Services входят в стандартную поставку и не требуют дополнительных отчислений.

Полнотекстовый поиск по БД. В сервер включена специальная версия MS Index Server, которая позволяет построить по текстовым (включая BLOB) полям полнотекстовый индекс и расширения SQL, позволяющие строить запросы по этому индексу, например:

Code: SELECT ProductName. FROM Products. WHERE CONTAINS(ProductName, 'spread NEAR Boysenberry').

Поиск по мемо полям.

В MS SQL Server 2000 включена специальная версия MS Index Server, которая позволяет построить по текстовым (включая BLOB) полям полнотекстовый индекс и расширения SQL, позволяющие строить запросы по этому индексу, например:

Code: SELECT ProductName. FROM Products. WHERE CONTAINS(ProductName, 'spread NEAR Boysenberry').

Особенности реализации клиентской части.

Особенности реализации клиентской части.

До версии 6.5 основным интерфейсом доступа к MS SQL Server со стороны клиента была библиотека DB-Library. Она реализовывала набор низкоуровневых интерфейсов, позволяющих организовать взаимодействие с сервером. Однако, в версии 7 Microsoft ввела новый интерфейс доступа – OLE DB. В связи с этим развитие DB-Library прекращено, и она оставлена лишь для обратной совместимости. Доступ через неё не поддерживает новых расширений сервера (UNICODE, текстовые поля до 8 Кбайт, тип данных GUID). Однако, старые приложения, не использующие этой функциональности сохраняют работоспособность, хотя может понадобиться некоторая их переделка в связи с изменениями в 7-й версии. Драйвер SQL Links реализует доступ при помощи DB-Library, и воспользоваться расширениями через него невозможно. Для обеспечения полноценного доступа к MS SQL Server 7.0 и выше необходимо использовать новый набор компонентов ADOExpress, включенный в Delphi 5. Работа через BDE возможна, но при этом сервер доступен в объеме возможностей версии 6.х. Также, существует ODBC драйвер, через который возможен полнофункциональный доступ к серверу. При работе с сервером версии 2000 на работу через BDE накладываются дополнительные ограничения, связанные с использованием индексов по вычисляемым полям.

Доступ при помощи ADOExpress.

ActiveX Data Objects (ADO) – надстройка над интерфейсом OLE DB, позволяющая обеспечить бизнес приложениям высокоуровневый доступ к данным. Эта технология включена в Windows 2000, а на остальных версиях доступна в виде бесплатного обновления. ADO автоматически устанавливается на компьютер при установке клиента MS SQL Server.

Начиная с версии 5.0 Delphi, в редакции Enterprise, включает в себя набор компонентов, позволяющих работать с ADO. Пользователи профессиональной редакции могут приобрести эти компоненты в виде отдельного продукта.

В качестве драйверов БД ADO использует так называемые OLE DB провайдеры, которые представляют собой COM-серверы, реализующие предопределенный набор COM-интерфейсов. Например, для доступа к набору данных служит интерфейс IRowset, возвращаемый OLE DB при открытии этого набора данных. Для указания ADO, какой провайдер и с какими параметрами должен использоваться служит строка подключения, которая содержится в свойстве ConnectionString компонентов ADOExpress.

Для её построения в состав Delphi включен мастер, позволяющий задать параметры графически.

Чтобы подключиться к MS SQL Server, необходимо указать тип провайдера «Microsoft OLE DB Provider for SQL Server» и в следующем окне заполнить информацию, необходимую для подключения.

После этого можно использовать компоненты ADO как обычных наследников TDataSet.

Необходимо отметить, что ADO в значительной мере оптимизировано для использования совместно с MS SQL Server 7.0. Полностью поддерживается модель работы Prepare-Execute, позволяющая эффективно кэшировать планы запросов, серверные курсоры (свойства CursorLocation и CursorType), возможность возврата запросом или хранимой процедурой нескольких наборов данных, прямой доступ к таблицам на сервере (без промежуточной генерации запроса). Например, задав в TADOQuery.SQL следующий код:

Code: SELECT * FROM One. SELECT * FROM Two.

Особенности реализации серверной части.

MS SQL Server имеет встроенный язык программирования Transact SQL, являющийся процедурным расширением стандарта ANSI SQL 92 entry level. T-SQL имеет полный набор средств для написания хранимых процедур и триггеров. Кроме этого реализованы некоторые расширения стандартного SQL, которые необходимо знать разработчику.

SELECT.

INSERT, UPDATE и DELETE.

CREATE TABLE и типы данных.

Написание триггеров.

Пакеты команд.

Обработка ошибок.

Блокировки.

Обработка транзакций.

Соответствие стандарту ANSI SQL 92.

Модель безопасности.

Оптимизатор запросов MS SQL Server.

Получение уникальных идентификаторов.

Временные таблицы.

Создание хранимых процедур и триггеров.

Кластерные индексы.

Определяемые пользователем функции.

SELECT.

В ранних версиях внешнее объединение таблиц задавалось выражением *= и =* во фразе WHERE. Этот синтаксис поддерживается, но не рекомендуется и будет исключен в будущих версиях. Начиная с версии 6.5, сервер поддерживает стандартный синтаксис {LEFT|RIGHT|FULL} [OUTER] JOIN.

Функция IDENTITY(data_type[, seed, increment]) позволяет при выполнении SELECT в таблицу (SELECT INTO) создать в этой таблице автоинкрементное поле IDENTITY и заполнить его. При помощи этой функции и временных таблиц можно пронумеровать результаты запроса.

Code: SELECT IDENTITY(INTEGER, 1, 1) AS Counter, Name. INTO #Temp. FROM MyTable. ORDER BY Name. SELECT * FROM #Temp.

Как вернуть результат в виде XML?

В MSSQL 2000 можно в запросе указать выражение FOR XML, в результате чего будет возвращена строка, содержащая XML представление выборки. Например, запрос:

Code: SELECT O.OrderID, O.CustomerID, O.OrderDate, O.ShipName, O.ShipAddress, O.ShipCity, O.ShipRegion, P.ProductName, OD.UnitPrice, OD.Quantity. FROM Orders O. INNER JOIN [Order Details] OD ON O.OrderId = OD.OrderId. INNER JOIN Products P ON OD.ProductId = P.ProductId. WHERE O.OrderId = '10248' FOR XML AUTO.

Вернет результат:

Code: <O OrderID="10248". CustomerID="VINET". OrderDate="1996-07-04T00:00:00". ShipName="Vins et alcools Chevalier". ShipAddress="59 rue de l&apos;Abbaye". ShipCity="Reims"> <P ProductName="Queso Cabrales"> <OD UnitPrice="14.0000" Quantity="12"/> </P> <P ProductName="Singaporean Hokkien Fried Mee"> <OD UnitPrice="9.8000" Quantity="10"/> </P> <P ProductName="Mozzarella di Giovanni"> <OD UnitPrice="34.8000" Quantity="5"/> </P> </O>

Возможно как автоматическое форматирование XML результатов запроса, так и задание способа форматирования программистом.

Кроме этого возможно использование XML данных в качестве таблицы в запросе. В качестве примера рассмотрим хранимую процедуру, выдающую данные по заранее неизвестному количеству записей. Идентификаторы записей передаются в неё в виде XML-документа.

Code: CREATE PROCEDURE XMLParam. @Ids VARCHAR(8000). AS. DECLARE @idoc int. EXEC sp_xml_preparedocument @idoc OUTPUT, @Ids. SELECT O.* FROM Orders O. INNER JOIN OPENXML (@idoc, '/ROOT/Ids', 1) WITH (ID INT) AS T ON. .OrderId = T.Id. EXEC sp_xml_removedocument @idoc. GO.

Вызов этой процедуры выглядит следующим образом:

Code: DECLARE @S VARCHAR(8000). SET @S = '<ROOT> <Ids ID="10250"/> <Ids ID="10257"/> <Ids ID="10258"/> </ROOT>' EXECUTE XMLParam @S.

Очевидно, что соответствующая строка параметров может быть легко построена и клиентским приложением.

Тенцер А. Л.

ICQ UIN 15925834.

Tolik@katren.nsk.ru.

©Drkb::02786.

Code: Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org). Select * From MyTable For XML AUTO, ELEMENTS.

INSERT, UPDATE и DELETE.

INSERT.

В дополнение к стандартным возможностям, MS SQL Server позволяет вставить в таблицу набор данных, полученный в результате выполнения хранимой процедуры, при помощи синтаксиса:

Code: INSERT author_sales EXECUTE get_author_sales.

CREATE TABLE и типы данных.

CREATE TABLE.

В версии 7.0 поддерживаются следующие типы данных:

BIT Целое число равное 0 или1. В Delphi возможно обращение к полю этого типа при помощи свойства AsBoolean (1 = True, 0 = False).

INT INTEGER 32-битное целое число в диапазоне от -2,147,483,648 до 2,147,483,647.

SMALLINT 16-битное целое число в диапазоне от 32,768 до 32,767.

TINYINT 8-битное целое число в диапазоне от 0 до 255.

DECIMAL[(P[, S])] NUMERIC, DEC Десятичное число с фиксированной точностью в диапазоне от - 10^38 -1 до 10^38 – 1 P – максимальное количество знаков в числе S – количество знаков после запятой.

MONEY Денежный тип данных. Целое 64-битное число, младшие 4 разряда которого отведены под дробную часть. Может хранить числа в диапазоне от -922,337,203,685,477.5808 до 922,337,203,685,477.5807. В Delphi соответствует типу данных Currency.

SMALLMONEY Аналогичен Money, но 32-разрядный и ограничен диапазоном от -214,748.3648 до 214,748.3647.

FLOAT DOUBLE PRECISION Число с плавающей точкой в диапазоне от -1.79E + 308 до 1.79E + 308.

REAL Число с плавающей точкой в диапазоне от -3.40E + 38 до 3.40E + 38.

DATETIME Дата и время в диапазоне от 1 января 1753 г. до 31 декабря 9999 г. с точностью 3.33 миллисекунды.

SMALLDATETIME Дата и время в диапазоне от 1 января 1900 г. до 6 июня 2079 г. с точностью до 1 минуты.

TIMESTAMP Уникальный в пределах БД идентификатор. Этот тип данных НЕ СОДЕРЖИТ времени и гарантирует лишь, что поле этого типа уникально в рамках базы данных.

UNIQUEIDENTIFIER Глобальный уникальный идентификатор. Статистически уникальное 16-битное значение. Над этим типом данных определены лишь операции =, <>, IS NULL и IS NOT NULL.

CHAR[(N)] CHARACTER, VARYING VARCHAR Строка фиксированной длины. N – длина строки. Максимальная длина – 8000 символов.

VARCHAR[(N)] CHARACTER VARYING(N) Строка переменной длины N – длина строки. Максимальная длина – 8000 символов.

TEXT Строка произвольной (до 2,147,483,647 символов) длины.

NCHAR[(N)] NATIONAL CHARACTER, NATIONAL CHAR Строка фиксированной длины в формате UNICODE. N – длина строки. Максимальная длина – 4000 символов.

NVARCHAR[(N)] NATIONAL CHARACTER VARYING(N), NATIONAL CHAR VARYING(N) Строка переменной длины в формате UNICODE N – длина строки. Максимальная длина – 4000 символов.

NTEXT NATIONAL TEXT Строка произвольной (до 1,073,741,823 символов) длины.

BINARY[(N)] VARYING VARBINARY Двоичные данные фиксированной длины, до 8000 байт N – длина данных.

VARBINARY[(N)] Двоичные данные переменной длины, до 8000 байт N – длина данных.

IMAGE Двоичные данные произвольной (до 2,147,483,647 байт) длины.

В версии SQL 2000 дополнительно появились:

Тип Синоним Примечание.

BIGINT 64-битное целое число.

SQL_VARIANT Может хранить данные произвольного типа.

Поддерживается создание вычисляемых полей.

Code: CREATE TABLE MyTable ( Direction BIT NOT NULL, Amount MONEY, CASE Direction. WHEN 1 THEN Amount. ELSE -Amount. END AS SignedAmount. )

Написание триггеров.

Триггеры в MS SQL Server срабатывают после обновления и один раз на оператор (а не на каждую обновленную запись). Количество триггеров на таблицу неограниченно. В триггере доступна обновленная таблица и две виртуальных таблицы Inserted и Deleted.

В них находятся:

Inserted Deleted.

INSERT Вставленные записи Нет записей.

UPDATE Новые версии записей Старые версии записей.

DELETE Нет записей Удаленные записи.

Триггер может, основываясь на содержании этих таблиц осуществить дополнительную модификацию данных, либо отменить транзакцию, вызвавшую этот оператор. Например:

Code: CREATE TRIGGER T1 ON MyTable FOR INSERT, UPDATE. AS BEGIN. -- Заносим в поля: -- LastUserName – имя пользователя, последним обновившего запись. -- LastDateTime – дату и время последнего обновления. UPDATE MyTable. SET LastUserName = SUSER_NAME(), LastDateTime = GETDATE(). FROM Inserted I INNER JOIN MyTable T ON I.Id = T.Id. END. CREATE TRIGGER T2 ON MyTable FOR DELETE. AS BEGIN. -- Этот триггер откатывает и снимает всю транзакцию. -- вызвавшую ошибку. IF EXISTS (SELECT * FROM Deleted. WHERE Position = 'Boss') BEGIN. RAISERROR('Нельзя удалять начальника', 16, 1). ROLLBACK. END. END. CREATE TRIGGER T3 ON MyTable FOR DELETE. AS BEGIN. -- А этот просто не дает удалить запись. -- позволяя продолжить транзакцию. IF EXISTS (SELECT * FROM Deleted. WHERE Position = 'Programmer') BEGIN. INSERT INTO MyTable. SELECT * FROM Deleted. WHERE Position = 'Programmer' RAISERROR('Программиста удалить тоже не получится', 16, 1). END. END.

Пакеты команд.

Операторы могут отправляться на сервер не поодиночке, а пакетами. Пакетом (batch) называется группа команд, отправленная клиентским приложением на сервер одновременно. Весь пакет компилируется в единый план исполнения. Такая техника позволяет уменьшить сетевой трафик и увеличить эффективность приложения. Типичный пакет может выглядеть следующим образом:

Code: BEGIN TRANSACTION. INSERT One (SomeField) VALUES (:1). INSERT Two (AnotherField) VALUES (:2). IF @@ERROR = 0. COMMIT. ELSE. ROLLBACK.

Обработка ошибок.

Для тог, чтобы проинформировать клиентское приложение об ошибке MS SQL Server использует функцию RAISERROR. При этом необходимо помнить, что:

• Выполнение процедуры этой функцией не прерывается, транзакции не откатываются. Если в этом есть необходимость – используйте ROLLBACK или RETURN

• Ошибки с severity ниже 10 являются информационными и не вызывают исключения компонентов работы с данными.

При возникновении ошибки в каком-либо из операторов внутри пакета выполнение пакета продолжается, а функция @@ERROR возвращает код ошибки, который можно обработать.

Code: INSERT MyTable (Name) VALUES ('Петров'). IF @@ERROR != 0. PRINT 'Ошибка вставки'.

Блокировки.

MS SQL Server поддерживает блокировку на уровне записи для всех операций модификации данных. Если оптимизатор решит, что количество блокируемых записей в таблице слишком велико, то он может произвести эскалацию блокировок на страницы или всю таблицу. Это происходит, например, при одновременном обновлении значительного количества записей. В этом случае гораздо быстрее заблокировать таблицу (или группу страниц в ней) выполнить модификацию, а затем разблокировать её, чем накладывать блокировку на каждую запись. Сервер не предоставляет средств для управления эскалацией блокировок и делает её автоматически.

Другим важным вопросом является модель обеспечения уровней изоляции транзакций REPEATABLE READ и SERIAZABLE. При выполнении транзакции с этим уровнем изоляции сервер блокирует диапазоны значений полей, по которым осуществляется выборка данных для предотвращения вставки «фантомных» значений. Например, если в транзакции с уровнем изоляции SERIAZABLE будет выполнен запрос.

SELECT * FROM MyTable WHERE Name BETWEEN 'A' AND 'C'

Сервер наложит блокировку по записи (Shared Lock) на диапазон значений, попавших в результат запроса, предотвращая тем самым вставку «фантомных» записей другими транзакциями. Блокировка будет удерживаться до конца транзакции. На измененные транзакцией записи накладывается блокировка по чтению (Exclusive Lock), предотвращающая чтение их другими транзакциями. Поэтому транзакции с высокими уровнями изоляции необходимо тщательно планировать и делать максимально короткими.

Обработка транзакций.

В MS SQL Server поддерживаются все определенные стандартом ANSI SQL 92 уровни изоляции транзакций:

READ UNCOMMITTED Позволяет транзакции читать неподтвержденные данные, других транзакций.

READ COMMITTED Предотвращает считывание транзакцией данных, не подтвержденных другой транзакцией.

REPEATABLE READ Все блокировки удерживаются до конца транзакции, гарантируя идентичность повторно считанных данных прочитанным ранее.

SERIALIZABLE Гарантирует отсутствие «фантомов». Реализуется за блокирования диапазонов записей, внутри которых эти «фантомы» могут появиться.

Для установки текущего уровня изоляции используется оператор.

Code: SET TRANSACTION ISOLATION LEVEL. { READ COMMITTED. | READ UNCOMMITTED. | REPEATABLE READ. | SERIALIZABLE. }

Соответствие стандарту ANSI SQL 92.

Соответствие стандарту ANSI SQL 92.

В MS SQL Server имеются настройки, позволяющие изменять степень соответствия сервера стандарту ANSI SQL 92.

SET ANSI_NULLS {ON|OFF} – регулирует результат сравнения значений, содержащих NULL. Если ANSI_NULLS = OFF, то запрос.

Code: SELECT * FROM MyTable WHERE MyField = NULL.

Модель безопасности.

Роли.

Вместо групп пользователей, использовавшихся в предыдущих версиях, седьмая версия использует роли пользователей. Права могут даваться или отниматься у роли, и это отражается на правах всех пользователей, ассоциированных с этой ролью. Пользователь может быть ассоциирован одновременно с несколькими ролями.

Для облегчения управления сервером и базами данных поддерживаются встроенные серверные роли и роли баз данных. Так, например, серверная роль serveradmin дает право на настройку конфигурации и остановку сервер, а роль базы данных db_securityadmin позволяет управлять правами доступа пользователей. Набор встроенных ролей позволяет не предоставлять административных привилегий пользователям, нуждающимся в каких-либо специфических правах. Так, роль db_securityadmin не предоставляет своим членам прав на чтение или модификацию пользовательских таблиц.

Интегрированная безопасность.

Сильной стороной MS SQL Server является его тесная интеграция с системой безопасности Windows NT. Права на доступ к серверу и базам данных можно давать пользователям и группам Windows NT. Механизм делегирования полномочий позволяет пользователям, подключившимся к одному из серверов иметь доступ к другим серверам в сети со своими правами, отличающимися от прав сервера, к которому они подключились. Также возможна прозрачная для пользователя проверка его полномочий при доступе к серверу через Microsoft Internet Information Server или Microsoft Transaction Server.

Оптимизатор запросов MS SQL Server.

В версии 7.0 существенно переработан оптимизатор запросов. Сервер может использовать несколько индексов на каждую таблицу в запросе, один запрос может исполняться параллельно на нескольких процессорах. В нем реализованы 3 метода выполнения операции слияния таблиц (JOIN):

1. LOOP JOIN – для каждой записи в одной из таблиц производится цикл по связанным записям второй таблицы. Этот метод наиболее эффективен для малых результирующих наборов данных.

2. MERGE JOIN – требует, чтобы оба набора данных были отсортированы по сливаемому полю (набору полей). В этом случае сервер осуществляет слияние за один проход по каждому из наборов данных. Т.к. они уже упорядочены, то нет необходимости просматривать все записи, достаточно выбирать их, начиная с текущей, пока значение поля не изменится. Это самый быстрый метод слияния больших наборов данных.

3. HASH JOIN – используется, когда невозможно использовать MERGE JOIN, а наборы данных велики. По одному из наборов строится хэш-таблица, а затем для каждой записи из второго набора вычисляется та же хэш функция и производится её поиск в таблице. На больших не отсортированных наборах данных этот алгоритм существенно эффективнее, чем LOOP JOIN.

При фильтрации по индексу сервер не осуществляет сразу выборку данных из таблицы. Вместо этого строится набор «закладок» (Bookmark), а затем производится выборка данных в одной операции (Bookmark Lookup). Это позволяет резко снизить количество обращений к диску.

Новые стратегии оптимизации требуют учета при проектировании БД и структуры индексов. Например, для следующей структуры таблиц:

Code: CREATE TABLE T1 ( Id INTEGER PRIMARY KEY, ... ) CREATE TABLE T2 ( Id INTEGER PRIMARY KEY, ... ) CREATE TABLE T3 ( Id INTEGER PRIMARY KEY, T1Id INTEGER REFERENCES T1(Id), T2Id INTEGER REFERENCES T2(Id), ... ) Запрос. SELECT * FROM T1. INNER JOIN T3 ON T1.Id = T3.T1Id. INNER JOIN T2 ON T2.Id = T3.T2Id. WHERE ...

Получение уникальных идентификаторов.

Сервер имеет средства для автоматической генерации уникальных идентификаторов, который могут использоваться в качестве первичного ключа. В качестве этих значений могут выступать целые числа, либо новый тип данных UNIQUEIDENTIFIER.

Для получения целочисленного уникального идентификатора записи в MSSQL используется ключевое слово IDENTITY [(seed, increment)].

Здесь:

Seed – начальное значение.

Increment – приращение.

По умолчанию seed и increment равны 1.

Чтобы создать в таблице автоинкрементный столбец необходимо написать:

Code: CREATE TABLE TableName ( Id INTEGER NOT NULL IDENTITY. )

Временные таблицы.

Для промежуточной обработки данных клиентское приложение может создавать временные таблицы. Временной является таблица, имя которой начинается с # или ##. Таблица, имя которой начинается с # является локальной и видима только той сессии, в которой она была создана. После завершения сеанса временные таблицы, созданные им автоматически удаляются. Если временная таблица создана внутри хранимой процедуры, она автоматически удаляется по завершению процедуры. Если имя таблицы начинается с ##, то она является глобальной и видима всеми сессиями. Таблица удаляется автоматически, когда завершается последняя из использовавших её сессий.

Для примера рассмотрим хранимую процедуру, которая выдает значения продаж по месяцам. Если в данном месяце продаж не было, выводится имя месяца и NULL.

Code: CREATE PROCEDURE AmountsByMonths. AS BEGIN. DECLARE @I INTEGER. CREATE TABLE #Months ( Id INTEGER, Name CHAR(20). ) SET @I = 1. WHILE (@I <= 12) BEGIN. INSERT Months (Id, Name) VALUES. (@I, DATENAME(month, '1998' + REPLACE(STR(@I,2),' ','0')+'01')). SET @I = @I + 1. END. SELECT M.Name, SUM(P.Amount). FROM #Months M INNER JOIN Payment P. ON M.Id = DATEPART(month, P.Date). DROP TABLE #Months. END.

Создание хранимых процедур и триггеров.

Если логика работы процедуры или триггера требует установки каких-либо SET-параметров в определенные значения, процедура или триггер могут установить их внутри своего кода. По завершении их выполнения будут восстановлены исходные параметры, которые были на сервере до запуска процедуры или оператора, вызвавшего срабатывание триггера. Исключением являются SET QUOTED_IDENTIFIER и SET ANSI_NULLS для хранимых процедур. Сервер запоминает их на момент создания процедуры и автоматически восстанавливает при исполнении.

MS SQL Server использует отложенное разрешение имен объектов и позволяет создавать процедуры и триггеры, которые ссылаются на объекты, не существующие при их создании.

Кластерные индексы.

MS SQL Server позволяет иметь в таблице один кластерный (CLUSTERED) индекс. Данные в таблице физически расположены на нижнем уровне B-дерева этого индекса, поэтому доступ по нему является самым быстрым. По умолчанию такой индекс автоматически создается по полю, объявленному первичным ключом. Все остальные индексы в качестве ссылки на запись хранят значение кластерного индекса этой записи, поэтому не рекомендуется строить его по полям большого размера. Также, для оптимизации операции вставки записей рекомендуется строить этот индекс по полю с монотонно возрастающими значениями. Исходя из этих рекомендаций, лучший кандидат на построение кластерного индекса – поле INTEGER (минимальный размер) IDENTIY (возрастание), объявленное как первичный ключ (заведомо уникальное, частый доступ по этому индексу).

Определяемые пользователем функции.

В версии MSSQL 2000 появилась возможность создавать в БД функции. Функции могут быть трех типов:

Скалярные функции.

Эти функции возвращают скалярную величину. Они аналогичны функциям в любом языка программирования.

Code: CREATE FUNCTION FirstWord (@S VARCHAR(255)). RETURNS VARCHAR(255). AS. BEGIN. DECLARE @I INT. SET @I = CHARINDEX(' ', @S). RETURN CASE @I WHEN 0 THEN @S. ELSE LEFT(@S, @I-1). END. END. GO. SELECT dbo.FirstWord ('Hello world !').

Советы по работе с MS SQL Server.

• Устанавливайте SET NOCOUNT ON. При установке OFF после каждого оператора сервер посылает клиенту сообщение DONE_IN_PROC с количеством обработанных записей. Запретив это, Вы кардинально сократите сетевой трафик и существенно увеличите производительность.

• При необходимости изменить режим блокирования какой-либо таблицы без изменения уровня изоляции транзакций используйте подсказки режима блокирования. Например, в следующем примере оператор SELECT накладывает на запись, предотвращая изменение её другими сессиями до окончания транзакции, несмотря на то, что установленный уровень изоляции не предусматривает этого:

Code: SET TRANSACTION ISOLATION LEVEL READ COMMITED. BEGIN TRANSACTION. SELECT * FROM City. WHERE Name = 'Ленинград' WITH (HOLDLOCK). -- Какие-то операторы, во время их выполнения. -- запись остается заблокированной. UPDATE City. SET Name = 'Санкт-Петербург' WHERE Name = 'Ленинград' COMMIT.

БД - хранилище объектов (статья).

Классической методикой проектирования БД является создание отдельной таблицы для каждой описываемой моделью данных сущности, затем, в процессе нормализации – выделение отдельных таблиц для хранения атрибутов сущности (таблицы-справочники). Такой подход хорошо работает для БД с относительно небольшим количеством описываемых объектов (десятки) и при несложных и статичных связях между ними. Однако, любое изменение структуры хранимых данных приводит к внесению изменений в структуру таблиц, эти данные отображающих. Несложная на этапе разработки, эта операция становится крайне проблематичной при больших объемах данных и отсутствии у разработчика непосредственного доступа к БД (например, если она стоит у заказчика). Многим, наверное, знакомы громоздкие, медленные и требующие огромного дискового пространства операции по конвертированию БД при переходе на новую версию продукта. Не менее неприятна работа с БД, исторически разросшейся до сотен таблиц, структуру которой сложно даже изобразить в читабельном виде. В связи с этим встает вопрос – а нельзя ли создать структуру данных, не требующую переделок при появлении новых сущностей, позволяющую хранить произвольную информацию и при этом достаточно простую и эффективную? Чудес, увы, не бывает. Любая универсальная система менее эффективна, чем специализированная. Однако, возможно создание решения, сочетающего приемлемую производительность и простоту с достаточной степенью универсальности.

Базовые тезисы.

Прежде чем продолжать, необходимо сформулировать основные принципы, на которых будет строиться проектируемая БД.

1. Каждая сущность, информация о которой хранится в БД – это объект

2. Каждый объект уникален в пределах БД и имеет уникальный идентификатор.

3. Объект имеет свойства (строковые, числовые, временные, перечислимые), которые описывают атрибуты сущности.

4. Объекты могут быть связаны между собой произвольным образом. Связь характеризуется связанными объектами и типом связи. Например, сотрудник фирмы может быть связан с отделом, в котором он работает связью типа «сотрудник в отделе» и т.п. Связь в некотором роде аналогична понятию ссылки на таблицу-справочник в традиционной модели БД.

5. Объект может быть хранилищем. В этом случае допускается хранение на нем других объектов (например, товара на складе).

Такая БД не привязана ни к какой бизнес модели и позволяет реализовать «над собой» практически любую бизнес-логику. Логика выделяется в отдельный программный слой и, как правило, реализуется на сервере приложений, где по запросу клиента создаются объекты, загружающие информацию о себе из БД и реализующие «поведение» объектов реального мира. В то же время, в силу однообразности модели хранения эти объекты несложно создаются на основе базовых классов, инкапсулирующих функциональность по загрузке и сохранению свойств и связей в БД.

Объекты.

Объект в нашей БД – это скорее логическое понятие, его главное назначение – предоставить уникальный идентификатор, по которому он будет отличаться. Кроме этого, каждый объект обладает типом. Типы описываются таблицей:

ObjType.

Id INTEGER Первичный ключ.

Code CHAR(10) NOT NULL UNIQUE Краткое название типа. Используется в программе для поиска объектов данного типа.

ItemName CHAR(30) Полное название типа, используется только для интерфейса.

Типами объектов может быть, например «Фирма», «Сотрудник», «Товар».

Для упрощения не будем реализовывать наследования, отмечу лишь, что для этого необходимо ввести в ObjType поле ParentId, ссылающееся на Id наследника.

Сами объекты хранятся в таблице.

Objects.

Id INTEGER Первичный ключ.

TypeId INTEGER REFERENCES ObjType(Id) Ссылка на тип объекта.

ItemName CHAR(50) Название объекта.

Поле Objects.ItemName заслуживает отдельного обсуждения. В этом поле хранится строка, описывающая объект и (часто) дублирующая одно из его свойств, либо формируемая как сочетание нескольких свойств (например, номер и дата договора, фамилия и инициалы человека). Такой подход приводит к известному дублированию информации и потенциальным аномалиям обновления. Однако, при работе через сервер приложений формирование этого поля реализуется очень просто, а при выводе в интерфейсе списков объектов получение наименования из этого поля существенно повышает общее быстродействие базы данных. В то же время, в системах, где преимущественно производится ввод информации и мало операций по её выборке можно отказаться от него, что позволит уменьшить накладные затраты на его формирование и обновление.

Таким образом, мы получаем возможность, хранить объекты произвольного количества типов. Выборка объектов конкретного типа производится запросом вида.

Code: SELECT O.Id, O.ItemName, OT.ItemName. FROM Objects O. INNER JOIN ObjType OT ON O.TypeId = OT.Id. WHERE OT.Code = 'EMPLOYEE'

Использование Microsoft ScriptControl (статья).

Введение.

При разработке настраиваемых информационных систем часто возникает необходимость добавить в свою программу встроенный язык программирования. Такой язык позволял бы конечным пользователям настраивать поведение программы без участия автора и без перекомпиляции. Однако самостоятельная реализация интерпретатора является задачей непосильной для многих разработчиков, а для большинства остальных потребует очень много времени и усилий.

В то же время, в Windows, как правило, уже имеется достаточно качественный интерпретатор, который может быть легко встроен в Вашу программу. Речь идет о Microsoft ScriptControl. Он стандартно устанавливается с Internet Explorer, входит в Windows 2000 и Windows 98, а для младших версий доступен в виде свободно распространяемого отдельного дистрибутива, объем которого составляет около 200 КБ. Получить его можно по адресу http://msdn.microsoft.com/scripting. В дистрибутив входит ActiveX-компонент и файл помощи с описанием его свойств и методов.

Добавление TScriptControl в программу.

Импорт ActiveX сервера.

Чтобы добавить Microsoft ScriptControl на палитру компонентов Delphi необходимо импортировать ActiveX компонент, под названием Microsoft Script Control.

После этого на закладке ActiveX появится не визуальный компонент TScriptControl, который можно разместить на форме.

Настройка свойств и вызов скриптов.

Рассмотрим ключевые свойства и методы TScriptControl.

Property Language: String.

Задает язык, интерпретатор которого будет реализовывать компонент. В стандартной поставке доступны VBScript и JScript, однако, если в вашей системе установлены расширения Windows Scripting, возможно использование других языков, таких как Perl или Rexx.

Property Timeout: Integer.

Задает интервал исполнения скрипта, по истечении которого генерируется ошибка. Значение –1 позволяет отключить ошибки таймаута и позволить скрипту исполняться неограниченное время.

Property UseSafeSubset: Boolean.

При установке этого свойства в TRUE компонент может выполнять ограниченный набор действий, заданный текущими установками безопасности в системе. Использование этого свойства полезно, если Вы запускаете скрипты, полученные, например, по Интернет.

Procedure AddCode(const Code: WideString);

Добавляет код, заданный параметром к списку процедур компонента. В дальнейшем эти процедуры могут быть вызваны при помощи метода Run, либо из других процедур скрипта.

ScriptControl1.AddCode(Memo1.Text);

Function Eval(const Expression: WideString): OleVariant.

Выполняет код, заданный в параметре Expression и возвращает результат исполнения. Позволяет выполнить код без добавления его к списку процедур компонента.

Procedure AddObject(const Name: WideString; Object_: IDispatch; AddMembers: WordBool);

Добавляет объект к пространству имен компонента. Объект должен быть OLE-automation сервером. Добавленный объект доступен как объект в коде скрипта. Например, если в программе создан Automation сервер External, реализующий метод DoSomething(Value: Integer), то добавив объект.

ScriptControl1.AddObject('External', TExternal as IDispatch, FALSE);

Мы можем в коде скрипта использовать его следующим образом:

Dim I.

I = 8 + External.DoSomething(8).

Function Run(const ProcedureName: WideString; var Parameters: PSafeArray): OleVariant;

Выполняет именованную процедуру из числа ранее добавленных при помощи метода AddCode. В массиве Parameters могут быть переданы параметры.

Procedure Reset;

Сбрасывает компонент в начальное состояние, удаляя все добавленные ранее объекты и код.

Таким образом, TScriptControl представляет собой достаточно гибкую исполняющую систему с возможностями расширения путем добавления в её пространство имен серверов автоматизации OLE.

Использование Microsoft ScriptControl.

Интеграция TScriptControl с VCL.

В существующем виде возможности TScriptControl сильно ограничены сложным доступом к классам VCL. Исполнение интерпретируемого кода – это хорошо, однако хотелось бы иметь возможность их него обращаться к компонентам в программе, получать и устанавливать их свойства, обрабатывать возникающие в них события, например следующим образом:

Code: Sub Main(). Dim Control. Control = Self.Controls("Panel2"). Control.Add "Panel3", "TPanel". With Panel3. .Align = "alTop". .BevelOuter = "bvNone". .Height = 40. .Caption = "". .Add "Btn", "TButton", True. With Btn. .Top = 10. .Left = .Top. .Caption = "Click me". End With. End With. End Sub. Sub Btn_OnClick(). Dim StatusBar. Dim Panel. Dim I. I = 0. For Each Panel In StatusBar.Panels. I = I + 1. With Panel. .Text = .Text & " " & CStr(I). End With. Next. End Sub.

Синхронизация процессов при работе с Windows (статья).

Синхронизация процессов при работе с Windows.

Задача синхронизации встает при одновременном доступе нескольких процессов (или нескольких потоков одного процесса) к какому-либо ресурсу. Поскольку поток в Win32 может быть остановлен в любой, заранее ему неизвестный момент времени возможна ситуация, когда один из потоков не успел завершить модификацию ресурса (например, отображенной на файл области памяти), но был остановлен, а другой поток попытался обратиться к этому же ресурсу. В этот момент ресурс находится в несогласованном состоянии, и последствия обращения к нему могут быть самыми неожиданными – от порчи данных, до нарушения защиты памяти.

Главной идеей, положенной в основу синхронизации потоков в Win32 является использование объектов синхронизации и функций ожидания. Объекты могут находиться в одном из двух состояний – Signaled или Not Signaled. Функции ожидания блокируют выполнение потока до тех пор, пока заданный объект находится в состоянии Not Signaled. Таким образом, поток, которому необходим эксклюзивный доступ к ресурсу, должен выставить какой-либо объект синхронизации в несигнальное состояние, а по окончании – сбросить его в сигнальное. Остальные потоки должны перед доступом к этому ресурсу вызвать функцию ожидания, которая позволит им дождаться освобождения ресурса.

Рассмотрим, какие объекты и функции синхронизации предоставляет нам Win32 API.

Функции синхронизации.

Функции синхронизации делятся на две основные категории – это функции, ожидающие единственного объекта и функции, ожидающие одного из нескольких объектов.

Функции, ожидающие единственного объекта.

Простейшей функцией ожидания является.

Function WaitForSingleObject(

HHandle: THandle; // идентификатор объекта.

DwMilliseconds: DWORD // период ожидания.

): DWORD; stdcall;

Функция ожидает перехода объекта hHandle в сигнальное состояние в течении dwMilliseconds миллисекунд. Если в качестве параметра dwMilliseconds передать значение INFINITE, функция будет ждать в течение неограниченного времени. Если dwMilliseconds равен 0, то функция проверяет состояние объекта и немедленно возвращает управление.

Функция возвращает одно из следующих значений:

WAIT_ABANDONED Поток, владевший объектом, завершился, не переведя объект в сигнальное состояние.

WAIT_OBJECT_0 Объект перешел в сигнальное состояние.

WAIT_TIMEOUT Истек срок ожидания. Обычно в этом случае генерируется ошибка, либо функция вызывается в цикле до получения другого результата.

WAIT_FAILED Произошла ошибка, например неверное значение hHandle. Более подробную информацию можно получить, вызвав GetLastError.

Следующий фрагмент кода запрещает Action1 до перехода объекта ObjectHandle в сигнальное состояние. Например, таким образом можно дожидаться завершения процесса, предав в качестве ObjectHandle его идентификатор, полученный функцией CreateProcess.

Code: Var. Reason: DWORD; ErrorCode: DWORD; Action1.Enabled := FALSE; Try. Repeat. Application.ProcessMessages; Reason := WailForSingleObject(ObjectHandle, 10); If Reason = WAIT_FAILED then begin. ErrorCode := GetLastError; Raise Exception.CreateFmt( 'Wait for object failed with error: %d', [ErrorCode]); End; Until Reason <> WAIT_TIMEOUT; Finally. Actionl.Enabled := TRUE; End;

Использование TwebBrowser (статья).

Использование TWebBrowser.

Во многих современных программах требуется работа с данными в формате HTML. В качестве средства для просмотра таких данных в Delphi используется ActiveX компонент TWebBrowser, который использует компонент WebBrowser, входящий в состав Microsoft Internet Explorer. Таким образом, он имеется на любом компьютере, на котором установлен Internet Explorer. Все последние версии Windows включают этот компонент в стандартной поставке и, более того, практически неработоспособны без него.

Базовые операции.

Для того, чтобы использовать TWebBrowser в своей программе необходимо разместить на форме соответствующий компонент, размещенный на закладке Internet. После этого, чтобы отобразить в нем страницу HTML, необходимо вызвать его метод Navigate.

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. Flags, TargetFrameName, PostData, Headers: OleVariant; Begin. WebBrowser1.Navigate('http://www.borland.com', Flags, TargetFrameName, PostData, Headers); End;

Компоненты ADO (статья).

В Delphi 5.0 появились компоненты для работы с Microsoft® ActiveX® Data Objects (далее ADO). ADO это технология стандартного обращения к реляционным данным от Microsoft. Эта технология аналогична BDE по назначению и довольно близка по возможностям.

Следует отличать компоненты Delphi, являющиеся частью библиотеки визуальных компонентов Delphi (VCL), и интерфейсы и объекты ADO, которые в них инкапсулированы. В дальнейшем, когда упоминается компонент – это компонент Delphi, а когда объект или интерфейс – это объект или интерфейс ADO.

Обзор компонент.

Для работы с ADO на вкладке компонентов ADO есть шесть компонентов: TADOConnection, TADOCommand, TADODataSet, TADOTable, TADOQuery, TADOStoredProc.

Рис. 0. Палитра компонент ADO.

TADOConnection аналогичен компоненту BDE TDatabase и используется для указания базы данных и работы транзакциями.

TADOTable – таблица доступная через ADO.

TADOQuery – запрос к базе данных. Это может быть как запрос, в результате которого возвращаются данные и базы (например, SELECT), так и запрос не возвращающий данных (например, INSERT).

TADOStoredProc – вызов хранимой процедуры. В отличие от BDE и InterBase хранимые процедуры в ADO могут возвращать набор данных, по этому компонент данного типа является потомком от TDataSet и может выступать источником данных в компонентах типа TDataSource.

TADOCommand и TADODataSet являются наиболее общими компонентами для работы с ADO, но и наиболее сложными в работе. Оба компонента позволяют выполнять команды на языке провайдера данных (так в ADO называется драйвер базы данных).

Разница между ними в том, что команда, исполняемая через TADODataSet, должна возвращать набор данных и этот компонент позволяет работать с ними средствами Delphi (например, привязать компонент типа TDataSource). А компонент TADOCommand позволяет исполнять команды не возвращающие набор данных, но не имеет штатных средств Delphi для последующего использования возвращенного набора данных.

Очевидно, что все компоненты должны связываться с базой данных. Делается это двумя способами либо через компонент TADOConnection либо прямым указанием базы данных в остальных компонентах. К TADOConnection остальные компоненты привязываются с помощью свойства Connection, к базе данных напрямую через свойство ConnectionString.

База данных может быть указана двумя способами через файл линка к данным (файл в формате Microsoft Data Link, расширение UDL), либо прямым заданием параметров соединения.

Значение свойства всех ConnectionString этих компонент могут быть введены напрямую в текстовой форме, но куда проще вызвать редактор свойства нажав на кнопку «…» в конце поля ввода. Окно этого свойства выглядит так:

Рис. 1.

При выборе «Use data link file» и нажатии на кнопку «Browse…» появляется стандартный диалог выбора файла. Этот файл можно создать в любом окне explorer-а (в этом окне открытия файла, в самом explorer, на desktop и т.д.) вызвав контекстное меню и выбрав пункт «New/Microsoft Data Link». Потом вызовите локальное меню для созданного файла и выберите в нем пункт «Open». После этого появится property sheet описанный чуть ниже. Эти же вкладки содержит и property sheet, вызываемый через пункт «Property» локального меню UDL файла, но в нем еще есть вкладки относящиеся к самому файлу.

Использование файлов Microsoft Data Link упрощает поддержку приложений, так как возможно использовать средства Windows для настройки приложения.

При выборе в редакторе свойства «Use connection string» и нажатии на кнопку «Build…» появляется такой же property sheet, как и при выборе «Open» для Microsoft Data Link файла.

В этом окне выбирается тип базы данных, местоположение базы и параметры соединения.

На первой странице выбирается тип базы данных или Provider, в терминах ADO.

Рис. 2.

Базы MS Access доступны как через «Microsoft Jet OLE DB Provider», так и через «Microsoft OLE DB Provider for ODBC».

Следующая страница зависит от выбранного типа базы, однако для всех типов есть кнопка «Test connection» позволяющая проверить правильность и полноту параметров.

Для «Microsoft Jet OLE DB Provider» она выглядит так:

Рис. 3.

Checkbox «Blank password» подавляет диалог ввода идентификатора и пароля пользователя при установлении соединения, если поле пароля пустое.

Checkbox «Allow saving password» сохраняет пароль в строке параметров соединения. Если он не отмечен, то введенный пароль будет использоваться только при выполнении тестового соединения.

Для «Microsoft OLE DB Provider for ODBC» эта страница выглядит так:

Рис. 4.

Радиокнопка «Use data source name» позволяет ввести предустановленный алиас ODBC, а через «Use connection string» вводится как алиасы так и тип ODBC драйвера и параметры соединения.

Параметры идентификации пользователя аналогичны выше описанным.

На странице «Advanced» расположены дополнительные параметры, с помощью которых устанавливается уровень доступа к файлу базы данных, таймаут сетевого соединения (то есть время через которое связь будет считаться потерянной, если сервер не отвечает) и уровень глубины проверки секретности соединения.

Рис. 5.

На странице «All» можно отредактировать все параметры с предыдущих страниц и параметры зависящие от провайдера, но не вошедшие на страницу «Connection». Редактирование осуществляется в виде параметр – значение, причем в текстовой форме, никаких диалогов нет. Помощи то же нет, эти параметры описаны только в документации на провайдер. Ее можно найти в MSDN Data Access Services/Microsoft Data Access Components (MDAC) SDK/Microsoft ActiveX Data Objects (ADO)/Microsoft ADO Programmer's Reference/Using Providers with ADO.

Рис. 6.

В компоненте TADOConnection есть свойства Provider, DefaultDatabase и Mode которые являются альтернативным методом задания частей строки параметров соединения – провайдера, базы данных (например, пути до базы MS Access) и режима совместного использования файлов базы данных. Эти значение этих свойств автоматически включаются в строку соединения, если были заданы до активизации компонента и автоматически выставляются после соединения.

Простейшее приложение.

Создадим простейшее приложение, состоящее из одной таблицы.

Создаем форму состоящую из трех компонент.

TADOTable с палитры компонент ADO,

TDataSource с палитры компонент Data Access,

TDBGrid c палитры компонент Data Controls.

Рис 7.

Связываем компоненты, устанавливая.

Свойство TDBGrid DataSource на компонент TDataSource,

Свойство DataSet компонента TDataSource на компонент TADOTable.

Теперь нам необходимо указать базу данных. Делается это в свойстве ConnectionString компонента TADOTable. При нажатии на кнопку «…» появится редактор параметров соединения. Отметим радокнопку «Use data link file», нажмите на кнопку «Browse…» и выберите в появившемся окне после файл линка к базе данных «\Program Files\Common Files\System\ole db\Data Links\DBDEMOS.UDL». Этот линк указывает на базу в формате MS Access, входящую в поставку Delphi.

После этого в свойстве TableName компонента TADOTable выберем таблицу customer.

Активизируем компонента TADOTable, установив свойство Active в True.

Приложение можно запускать. Этот пример можно найти в директории Simple.

Обзор ADO.

ADO основано на технологии COM. Все объекты и интерфейсы ADO являются интерфейсами и объектами COM.

Рис 8. Архитектура ADO.

Интерфейс Connection.

Объекты этого типа выполняют следующие функции:

• Связь с сервером.

• Управление транзакциями.

• Получение информации о произошедших ошибках (свойство Errors).

• Получение информации о схеме данных (таблицы, поля и так далее).

Рис 9. Схема взаимодействия в ADO основных COM интерфейсов.

Интерфейсы Recordset и Field.

Интерфейс Recordset (на нижнем уровне ADO это IRowset) является аналогом TDataSet в Delphi.

Поддерживает текущее положение и перемещение курсора, закладки (bookmarks), чтение, изменение и удаление записей и так далее. Значение полей и их типы доступны с помощью свойства Fields.

Интерфейс Field позволяет получать значение поля, его тип длину и так далее.

Интерфейсы Command и Parameter.

Эти два типа позволяют работать с командами источника данных. Синтаксис команд для каждого из источников свой.

Интерфейс Property.

Все объекты, кроме Parameter, имеют свойство Properties, которое позволяет получать и устанавливать параметры специфические для провайдера данных.

Библиотека довольно запутанная, многие функции дублированы в разных объектах. Например, Recordset можно создавать напрямую, методом Open, (причем предварительно создавать Connection не обязательно), можно получить как результат выполнения метода Command.Execute, либо после Connection.Execute задав команду без параметров.

Интерфейс Command инкапсулирован во все компоненты за исключением TADOConnection. Это сделано потому, что в ADO нет возможности получить данные не выполнив команду.

Интерфейс Recordset инкапсулирован в компоненты производные от TCustomADODataSet. Это компоненты TADODataSet, TADOTable, TADOQuery, TADOStoredProc. Получать данные из них возможно штатными средствами Delphi.

Возможно получение данных и при выполнении компонента TADOCommand. Метод этого компонента Execute возвращает тип _Recordset. После чего его можно, например, связать с компонентом TADODataSet следующим образом.

ADODataSet1.RecordSet := ADOCommand1.Execute;

Компоненты TADOTable, TADOQuery и TADOStoredProc являются частными случаями команды, соответственно для таблицы, SQL запроса и хранимой процедуры.

Тип Connection инкапсулируется в компонент TADOConnection.

Когда вы выполняете команду предварительно не открывая соединение, оно все равно создается. Получить к нему доступ возможно через свойство Recordset. Привязать компонент TADOConnection к уже открытому соединению возможно через свойство ConnectionObject.

Информацию о структуре базы данных можно получить с помощью метода OpenSchema компонента TADOConnection. Эта информация представлена как набор таблиц, как стандартизованных, так и специфических для провайдера. Таким способом можно узнать список таблиц, запросов, хранимых процедур и многое другое. Однако изменять структуру базы с помощью возвращаемых наборов данных невозможно.

Пример использования TADOConnection.

В этом примере рассматривается работа с компонентом TADOConnection, SQL запросами с параметрами и трансакциями.

Создадим приложение из следующих компонентов.

Connect типа TADOConnection.

MasterSQL и DetailSQL типа TADODataSet.

MasterDS и DetailDS типа TDataSource.

MasterGrid и DetailGrid типа TDBGrid.

Рис 10. Master-detail форма на этапе дизайна.

Связываем MasterGrid, MasterDS, MasterSQL и DetailGrid, DetailDS, DetailSQL аналогично предыдущему примеру, за исключением того, что вместо типа TADOTable используется тип TADODataSet.

Привязываем Connect к базе данных. Для этого в редакторе свойства ConnectionString выбираем ту же базу данных, что и в предыдущем примере.

Для ввода SQL запросов необходимо отредактировать свойство CommandText компонентах MasterSQL и DetailSQL. После нажатия на кнопку «…» появится редактор компонент, который выглядит следующим образом.

Рис. 10.

Кнопка «Add Table to SQL» добавляет в текст SQL запроса таблицу, выбранную в списке «Tables», а «Add Field to SQL» поле таблицы, выбранное в списке «Fields».

Запрос для MasterSQL.

Select VendorNo, VendorName, Country, City, State, Preferred.

From vendors.

Запрос в DetailSQL должен выбирать только те детали, поставщик которых является текущим в MasterSQL. Для этого установим свойство DataSource компонента DetailSQL в значение MasterDS.

Запрос для DetailSQL следующий:

Select PartNo, OnOrder, OnHand, ListPrice, Description, Cost.

From parts.

Where VendorNo = :VendorNo.

:VendorNo в части where – параметр запроса. Параметры при установленном DataSource берутся из него.

Активизируем MasterSQL и DetailSQL аналогично предыдущему примеру.

Приложение можно запускать. Этот пример можно найти в директории MasterDetail.

Пример использования параметров запроса.

Теперь ограничим выборку поставщиков по значению поля State. Для этого добавим к форме следующие компоненты StateEdit типа TEdit c вкладки Standard, QueryButton типа TButton c вкладки Standard.

Изменим запрос в MasterSQL на.

Select VendorNo, VendorName, Country, City, State, Preferred.

From vendors.

Where State = :StateID.

:StateID – параметр, вместо которого при выполнении подставляется значение.

Добавим так же обработчик события OnClick в QueryButton следующего содержания.

Procedure TForm1.QueryButtonClick(Sender: TObject);

Begin.

MasterSQL.Active := False;

DetailSQL.Active := False;

MasterSQL.Parameters.ParamByName('StateID').Value := StateEdit.Text;

MasterSQL.Active := True;

DetailSQL.Active := True;

End;

Программа готова.

Синхронизация данных клиента и сервера.

В ADO используются три метода синхронизации данных на клиенте и сервере.

Первый – c помощью метода Resync, который повторно считывает записи набора. Этот метод используется при выполнении метода Refresh Delphi.

Второй – повторный запрос методом Requery, который заново выполняет запрос на сервере. Выполнение этого метода то же самое, что и выполнение подряд закрытия и открытия набора данных.

Третий- уведомление сервером клиента в случае изменения данных.

Этих методы доступны во всех компонентах имеющих набор данных. Однако эти функции доступны не для всех баз данных.

Работа с транзакциями.

В компонентах ADO работа с транзакциями осуществляется через компонент TADOConnection.

Тип транзакции устанавливается в свойстве IsolationLevel одной из следующих констант:

IlUnspecified Сервер будет использовать лучший, по его мнению, тип изоляции.

IlChaos Транзакции с более высоким уровнем изоляции не могут изменять данные измененные, но не подтвержденные в текущей транзакции.

IlReadUncommitted Чтение данных измененных в не подтвержденных транзакций. То есть изменения видны сразу после того как другая транзакция передала их на сервер.

IlBrowse То же самое что и IlReadUncommitted.

IlReadCommitted Чтение данных измененных подтвержденными транзакциями. То есть изменение данных будет видимо после выполнения Commit в другой транзакции.

IlCursorStability То же самое что и IlCursorStability.

IlRepeatableRead Изменения, сделанные другими транзакциями не видимы, но при выполнении перезапроса они транзакция может получать новый набор данных.

IlIsolated Транзакция не видит изменений данных произведенных другими транзакциями.

IlSerializable То же самое что и IlIsolated.

Обратите внимание на то, что не все типы провайдеров данных поддерживают все типы изоляции или работу с транзакциями.

Свойство Attributes устанавливает открывать ли новую транзакцию автоматически.

XaCommitRetaining – при подтверждении транзакции.

XaAbortRetaining – при отмене транзакции.

Так же у компонента TADOConnection есть три метода для работы с транзакциями:

BeginTrans Начинает транзакцию.

CommitTrans Подтверждает сделанные изменения.

RollbackTrans Откатывает транзакцию.

Пример работы с транзакциями.

За базовый возьмем пример использования TADOConnection.

Добавим к форме две кнопки (StCmButton и RollbackButton) типа TButton, обработчики событий OnClick этих кнопок, процедуру fix_controls без параметров к форме, обработчик события OnActivate формы.

Code: Type. TForm1 = class(TForm). … Private. Procedure fix_controls; … Procedure TForm1.fix_controls; Begin. If Connection.InTransaction then. Begin. StCmButton.Caption := 'Commit'; RollbackButton.Enabled := True; End. Else. Begin. StCmButton.Caption := 'Begin'; RollbackButton.Enabled := False; End; MasterSQL.Requery; DetailSQL.Requery; End; Procedure TForm1.StCmButtonClick(Sender: TObject); Begin. If not Connection.InTransaction. Then Connection.BeginTrans. Else Connection.CommitTrans; Fix_controls; End; Procedure TForm1.RollbackButtonClick(Sender: TObject); Begin. Connection.RollbackTrans; Fix_controls; End; Procedure TForm1.FormActivate(Sender: TObject); Begin. Fix_controls; End;

Использование ассемблера в Дельфи (статья).

© Guido Gybels, January-February 2001, All rights reserved.

© Anatoly Podgoretskys, 2002, Authorized Russian Translation.

Ввведение.

Об основах ассемблерных процедур.

Замечания о синтаксисе.

Примеры.

Vit - Печатается в DRKB с сокращениями.

©Drkb::00291.

Ввведение.

© Guido Gybels, January-February 2001, All rights reserved.

© Anatoly Podgoretskys, 2002, Authorized Russian Translation.

Вводная глава: Нужно ли это вам?

Многие программисты сегодня ассоциируют ассемблер как сложный, низкоуровневый язык программирования. Они считают его быстрым, но большинство их них думает, что его сложно или невозможно изучить. В действительности, положение не настолько сложно. Вполне возможно научиться писать хороший код, не будучи гением. С другой стороны, не думайте, что несколько уроков позволят вам производить более быстрый код, чем получится с помощью Паскаля. Причина в том, что когда вы пишите на Паскале, то вы на самом деле пользуетесь услугами высокоэффективного программиста – компилятором Дельфи. В целом код производимый им очень эффективный и быстрый. После некоторых уроков по специальным методам кодирования вы сможете сделать более эффективный код, чем Паскаль и Дельфи. Робертом Ли был создан и обслуживается наиболее исчерпывающий сайт по этой теме. Каждый серьезный программист должен познакомиться с информацией на этом сайте.

Большинство программистов считают, что собственный ассемблерный код по определению быстрее, чем скомпилированный компилятором Паскаля. Конечно, так не всегда. Плохо написанные процедуры на Ассемблере могут оказаться по качеству хуже и могут вызвать странные ошибки и проблемы в ваших приложениях. Задачей данных статей не является обучить вас основам Ассемблера. Есть много другой информации в других источниках и конечно вы должны быть в хороших отношениях с системой команд процессоров Intel (в статьях фокус сделан на серию Пентиум, особенно PII и PIII) на уровне обычного программирование. Вы можете найти руководства по семейству процессоров на сайте http://developer.intel.com. И также на сайте (http://webster.cs.ucr.edu/) «The Art of Assembly», очень солидное руководство по программированию на Ассемблере, который должны посмотреть, если хотите заняться серьезным программированием на ассемблере.

В тот момент, когда вы придете к выводу, что ассемблер это нужный вам путь, вы не должны хвататься за него, как за соломинку. Проверьте внимательно свою программу на предмет определения слабых мест. Профилировщик может немного в этом помочь, но лучше обратите особое внимание на структуру и алгоритм. Часто, вы сможете получить лучшие результаты, за счет оптимизации алгоритмов, скорее, чем с помощью ассемблера. С другой стороны, в некоторых особых случаях, таких как манипуляции с битами, ассемблер даст лучший и более простой результат.

Если вы решите, что ассемблер действительно нужен, то потратьте немного времени на планирование вашего кода и алгоритмов. Только после того, как вы будете четко представлять, что вы хотите сделать и как, вы можете приступать к реализации вашей идеи. Если вы не будете об этом думать, то получите кашу из кода, закрученные операторы и трудно управляемую программу.

Для фазы реализации существует несколько обычных правил, которым надо следовать.

Первое важное правило: делайте ваши процедуры как можно короче, ассемблер должен использоваться, только для реально необходимых вещей, в которых важна максимальная производительность. В большинстве случаев делайте это, с помощью простых, но специализированных процедур. Если вы видите, что у вас длинные куски ассемблерного кода в вашем проекте, вы вероятнее всего просто фанат ассемблера.

Второе правило: делайте ваши процедуры читабельными за счет комментирования кода. В связи с линейной структурой ассемблерного кода, каждая отдельная инструкция читается легко сама по себе. Комментарии нужны для объяснения реализации алгоритма, чтобы другие могли понять, что же вы здесь делаете. Не добавляйте комментарии ради самих комментариев. Ваши комментарии должны быть полезны и не избыточны. Например, не делайте подобного:

Inc EDX {увеличить значение EDX}.

Подобный тип комментариев не имеет смысла, поскольку инструкция говорит сама за себя. Комментарии должны описывать внутреннюю работу алгоритма, не дублируя мнемонику команд.

Третье правило: избегайте использования медленных инструкций. В основном должны использоваться простые инструкции вместо сложных агрегатных инструкций, так как последние реализованы с помощью микрокода. Подробное обсуждение этой темы можно найти в работе Agner Fog на сайте http://www.agner.org/assem/. Попробуйте прочитать это несколько раз, глава за главой, пока полностью не поймете основную идею. Это, однако, не означает, что вы не должны их никогда использовать, но это даст вам понимание написания оптимального кода.

И последнее правило: проверяйте свои ассемблерные подпрограммы особенно тщательно. Для подпрограмм, написанных на ассемблере, компилятор делает намного меньше предупреждений и сообщений об ошибках. Особенно будьте внимательны с логическими конструкциями вашего алгоритма. Неиспользуемые переменные и неверное использование указателей не может быть определено так же просто, как и в коде на Паскале. Так, что готовьтесь к интенсивному тестированию и отладке вашего кода. Это потребует больше времени и усилий по сравнению с отладкой Паскаль-кода. Это одна из причин делать процедуры как можно короче и читабельнее.

После этого вступления, мы готовы приступить к реальному изучению предмета. Эти статьи писались с учетом специфики - это означает, большинство информации относится к BASM (сокращение от built-in assembler – встроенный ассемблер) для всех 32-битных версий Дельфи, начиная с третьей. В основном это верно и для Дельфи 2, но это версия сильно устаревшая. Имеется также некоторые проблемы с утечкой памяти для Дельфи 2, и обычно я рекомендую использовать Дельфи версии 3.02 и выше. Если у вас версия 3,4 или 5, то вся информация в данных статьях применима к ним. Если потребуются специфические требования к версии Дельфи, то это будет особо указано.

Об основах ассемблерных процедур.

Глава 1: Об основах ассемблерных процедур.

Когда вы захотите добавить хороший и успешный ассемблерный код внутрь проекта на Дельфи, вам потребуется вызвать BASM процедуру, передать в нее переменные и принять обратно результат. Для этого вы должны знать, как работают соглашения о передаче параметров. На первом шаге мы обсудим основное: подпрограммы на ассемблере, получают некоторые переменные для обработки, возвращают впоследствии результаты. Позже, в других главах, мы обсудим, как вызывать другие функции, методы и процедуры из ассемблерного кода с помощью регистров и стека.

1.1. Где размещать ассемблерный код.

Ассемблерные инструкции размещаются внутри блока asm...end. Эти блоки могут появляться внутри процедур и функций обычного кода, но я настоятельно не рекомендую поступать таким образом. Гораздо лучше изолировать их в отдельной функции или процедуре. Вставка asm блока внутри обычной процедуры создает сложности для компилятора Паскаля и код становится не эффективным с точки зрения производительности. Переменные, которые обычно передаются через регистры, в этом случае будут передаваться через стек или перезагрузку. Также, это заставляет компилятор адаптировать собственный код к вашему вставленному коду, что делает механизм оптимизации менее эффективным. Так, что это становится правилом помещать ассемблерный код в отдельную процедуру или функцию. Кроме того - это вопрос проектирования. Читабельность и управляемость вашего кода становится выше, если он помещен в свой собственный блок.

Часто, ассемблерный код ассоциируется со скоростью. Поэтому циклы вы также должны по возможности организовывать внутри ассемблерного кода. Это не сложно, а иначе вы просто потеряете множество времени за счет постоянного вызова. Вместо того, чтобы делать так (см. примечание 1):

Code: Function CriticalCode(...): ...; register; Asm. ... {Here comes your assembler code}. ... End; Procedure Example; Var I: Integer; Begin. I:=0; ... While I < NumberOfTimes do. Begin. CriticalCode(...); Inc(I); End; ... End;

Вы должны сделать так:

Code: Function CriticalCode(...): ...; register; Asm. ... Mov ECX,{NumberOfTimes}. @@loop: ... {Остальной код}. ... Dec ECX. Jnz @@loop. ... End; Procedure Example; Begin. ... CriticalCode(...); ... End;

Использование цикла в обратном направлении позволяет просто проверять флаг установки нуля после команды dec. Если же цикл начинать с нуля, то потребуется больше на одну команду сравнения с конечным значением, каждый раз при проходе цикла.

Code: Mov ECX,0. @@loop: ... Inc ECX. Cmp ECX,{NumberOfTimes}. Jne @@loop.

Другая возможность – это вычесть значение NumberOfTimes из 0 и затем увеличивать переменную цикла, пока она не станет равной нулю. Этот метод обычно используется, когда переменная цикла также является индексом в таблице или массиве в памяти, поскольку механизм кэширования работает лучше, чем при доступе в прямом направлении. Это можно сделать так:

Code: Xor ECX,ECX. Sub ECX,{NumberOfTimes}. @@loop: ... Inc ECX. Jnz @@loop.

Помните, что в этом случае базовый регистр или адрес, должен указывать на конец массива, вместо его начала.

(1) В данных главах мы специально указываем соглашение о вызове. На самом деле указание register избыточно, так как соглашением по умолчанию является передача параметров через регистры, это сделано исключительно для читабельности (или как дополнительный комментарий) и как напоминание читателю, что параметры передаются через регистры. Этот совет поступил от Christen Fihl, http://HSPascal.Fihl.net.

1.2. Код входа/выхода и сохранение регистров.

Компилятор автоматически генерирует необходимый код входа и выхода из ассемблерных подпрограмм.

Код входа выглядит так:

Code: Push EBP. Mov EBP,ESP. Sub ESP, {Размер стека для локальных переменных}.

А код выхода так:

Code: Mov ESP,EBP. Pop EBP. Ret {Размер стека резервированный для параметров}.

Однако, если ваша процедура не имеет никаких локальных переменных или параметров на стеке, то компилятор не делает кода входа/выхода, за исключением инструкции ret.

Код входа сначала сохраняет текущее значение регистра EBP на стеке, поскольку его требуется восстановить при выходе. Затем, устанавливает значение EBP, как базу для доступа к параметрам и локальным переменным, которые также размещаются на стеке. Более подробно мы обсудим этот механизм позже.

Код выхода сначала освобождает память, распределенную для локальных переменных, путем подстройки указателя стека, а затем восстанавливает регистр EBP в его предыдущее состояние и производит возврат в вызвавшую программу. Для всех соглашений, исключая cdecl, процедура сама очищает стек, путем соответствующего варианта инструкции ret, Для соглашения cdecl очисткой стека занимается вызвавшая программа. Снова, все это мы рассмотрим подробнее в дальнейшем.

Внутри вашей функции или процедуры, содержимое регистров EAX, ECX, EDX можно полностью изменять и нет необходимости возвращать их в исходное состояние, кроме того, регистр EAX или его часть часто используется для возврата результата. Если вы изменяете, другие регистры общего назначения (EBX, ESI, EDI), то вы обязаны восстановить их первоначальное состояние до выхода из процедуры. То же самое относится и к регистрам ESP и EBP. Вы также не должны никогда изменять содержимое сегментных регистров (ds, es и ss указывают на один и тот же сегмент; cs имеет свое собственное значение; fs используется Windows и gs резервирован).

Регистр ESP указывает на верхушку стека, а EBP указывает на текущий фрейм стека и генерируется по умолчанию компилятором как код входа. Поскольку каждая инструкция pop и push изменяет содержимое регистра ESP, то его использование не является хорошей идеей для доступа к стеку. Для этих целей зарезервирован регистр EBP. Смотрите Таблицу 1, в которой приведено суммарное описание по использованию регистров в Дельфи.

И в дополнение к регистрам, вы также должны сохранять состояние флага направления. При входе в функцию флаг направления сброшен и если вы его изменяете, то вы должны сбросить его до выхода из функции, сделать это можно с помощью инструкции cld.

И наконец, вы также должны очень осторожно относиться к управляющему слову сопроцессора. Поскольку оно позволяет менять режим точности и округления, а также маскировать определенные исключения, то это может драматически изменить результат вычислений в вашей программе. Если у вас возникла нужда в изменении управляющего слова, то постарайтесь восстановить его значение как можно быстрее. Если вы используете типы Comp или Currency, то не уменьшайте точность!

1.3. Передача информации через регистр.

При использовании соглашения по умолчанию, передачу через регистры, Дельфи может передавать до двух методов или до трех параметров через регистры процессора. Это означает, что нет необходимости генерировать фрейм стека для передачи параметров. Не все типы могут быть переданы через регистры, а только те, которые помещаются полностью в регистр. Поэтому, многие сложные типы передаются или через стек, или через память, и вместо самих типов передается указатель через регистр. Это означает, что любой тип может быть передан через регистр, как указатель, за исключением указателей методов, которые всегда передаются как два 32-разрядных указателя, размещенных на стеке.

Текущее поколение процессоров, для которых написана данная статья, обычно называются как Intel Pentium процессоры, имеет регистры шириной в 32 бита. Когда передаваемая информация не полностью использует регистр (для типов слово и байт), то используется, только часть регистра, байты используют младшие восемь бит, например al и для слов младшее слово, например ax. Указатели всегда 32-битные (по крайней мере, пока не появятся 64-битные процессоры) и занимают весь регистр полностью, например eax. В случае переменных типа байт и слово оставшаяся часть регистра не определена и вы не должны делать никаких предположений относительно его содержимого. Например, при передаче байта в функцию, через регистр al, остальные 24 бита регистра eax не определены и вы, конечно, не можете рассчитывать на то, что они равны нулю. Вы просто можете использовать инструкцию and для очистки оставшихся бит.

Code: And EAX,$FF {беззнаковый байт в AL, очистка старших 24 бит}.

Или.

Code: And EAX,$FFFF {беззнаковое слово в AX, очистка старших 16 бит}.

Когда вы передаете знаковые параметры (ShortInt или SmallInt), вы должны расширить их с учетом знака. Для расширения знака для байтового параметра до двойного слова, вы должны использовать две инструкции:

Cbw {расширение al до ax}.

Cwde {расширение ax до EAX}.

Для демонстрации, напишите следующую тестовую подпрограмму:

Code: Function Test(Value: ShortInt ): LongInt; register; Asm. End;

Разместите кнопку и метку на форме и поместите следующий код в обработчик OnClick:

Code: Var I : ShortInt ; Begin. I := -7; Label1.Caption := IntToStr(Test(I)); End;

Замечания о синтаксисе.

Глава 2: Замечания о синтаксисе.

В этой главе, мы рассмотрим синтаксические требования, которые вам требуется знать. Если вы использовали отдельный ассемблер, то вы заметили, что встроенный ассемблер в Дельфи 1-5 поддерживает только относительно небольшой набор возможностей языка. Эта ситуация была улучшена с выходом Дельфи 6, теперь компилятор распознает набор MMX, SIMD и SSE инструкций (так же и Enhanced 3D для AMD CPU, но данная статья сфокусирована только на Intel, и мы не будем обсуждать это в дальнейшем). С другой стороны, это также дает возможность использовать некоторые OP конструкции внутри ассемблерного кода.

2.1. Инструкции и команды.

Ваш код на ассемблере состоит из нескольких выражений. Каждая инструкция состоит как минимум из одной команды. В большинстве случаев, вам потребуется использовать от одного до нескольких операндов. Операнды разделяются символом запятой. Также в инструкции могут использоваться префиксы (например, rep или lock). Наконец, инструкция может включать метку (смотрите ниже рассуждения о метках).

Примеры допустимых инструкций:

Cdq {только команда}.

Bswap EAX {команда и один операнд}.

Mov EAX,[ESI] {команда и два операнда}.

Imul EAX,ECX,16 {команда и триа операнда}.

Rep movsd {префикс и коаднда }.

@@Start: rep stosd {локальная метка, префикс и команда }.

Разрешено помещать несколько инструкций в одной строке, разделяя их точкой с запятой, Но я настоятельно не рекомендую так делать. Это сильно снижает читабельность вашей программы, и не добавляет при этом никакой эффективности, повышения скорости или каких-либо других преимуществ. При использовании по одной инструкции в строке не требуется ставить точку с запятой в конце строки (как это требуется для обычного Паскаль кода).

Комментарии могут быть добавлены в конце строки, но не могут размещаться внутри инструкции.

2.2. Набор команд.

Встроенный ассемблер Дельфи 2-5 поддерживает только подмножество команд процессора Intel 80486 (документация по Дельфи 3 вообще утверждает, что только 80386, но дополнительные инструкции процессора 80486, например bswap, xadd, cmpxchg, fstsw ax, и другие в действительности распознаются и обрабатываются корректно). Тем не менее, специфические команды Pentium, например cpuid или условные перемещения из Pentium Pro, PII и PIII, не распознаются встроенным ассемблером в этих версиях. В Дельфи 6, поддержан полный набор команд от Pentium I до IV. Включая специальные расширения MMX, SSE и другие. Это действительно серьезное улучшение, поскольку в более ранних версиях приходилось их кодировать вручную с помощью инструкций db (см. ниже). Это было довольно неприятно, так как эти инструкции особо интересны для специальных случаев.

Если вы желали использовать эти инструкции в Д2-Д5, то должны были вставлять их вручную с помощью серии инструкций db. Ясно, что вы не только должны были быть очень осторожны при вставке их в код, избегая ошибок, но и также особо комментировать эти строки. Со следующей ссылки вы можете загрузить .pas, который содержит исходный текст класса TCPUID, в котором интенсивно используется ассемблер, и в котором инструкция cpuid закодирована с помощью инструкций db. Нажмите здесь для загрузки cpuinfo.pas с сайта автора или с текущего каталога в формате cpuinfo.zip.

Вы должны проштудировать исходный код cpuinfo.pas, обратив особое внимание на функцию GetCPUIDResult, которая написана полностью на basm. Программа вызывает cpuid для различных уровней ID, которые поддержаны и заполняет запись типа TCPUIDResult полученной информацией. Данный тип записи используется в методах класса TCPUID. Заметим, что все поля записи TCPUIDResult адресуются через их имена, вместо расчета смещения. Компилятор сам рассчитывает смещение, так что если структура записи будет изменена, то код будет продолжать работать корректно.

Заметим, что команда cpuid уничтожает содержимое всех нормальных регистров, так что требуется особая осторожность при работе с ними. При этом так же сбрасываются все конвейеры, и ожидается окончание работы всех оставшихся инструкций, поэтому вы не должны использовать это в критических ситуациях. После выполнения инструкции cpuid, все нормальные регистры, включая EAX и другие, будут изменены.

Полное описание набора команд процессоров можно найти на сайте фирмы Intel http://developer.intel.com. Как я заметил во введении, данная статья посвящена только процессорам фирмы Intel не только, поскольку они самые распространенные, но и потому что они являются стандартом де-факто для набора команд процессора и сопроцессора. Некоторые другие производители имеют в составе своих процессоров дополнительные команды, но поскольку они присутствуют только в их процессорах, вы не должны пытаться их использовать, чтобы ваши приложения могли работать на более широком спектре систем. Другим решением является иметь различные варианты критичных по времени кусков кода, оптимизированные для различных процессоров. В начале вашей программы вы должны проверить тип процессора и установить глобальный флаг, который будет указывать, какую версию использовать.

Аналогичный вопрос: какой минимальный набор инструкций должен быть в вашей программе, что бы она могла работать на 80486 или более ранних процессорах. Конечно, 80486 и более старые процессоры уже устарели и, как минимум, стоит ориентировать вашу программу на Intel Pentium Plain или выше. Тем не менее, если выбрать более новую модель, как базис, например Pentium II и выше, то вы игнорируете многие компьютеры с Pentium Plain и Pentium MMX, которые еще в ходу. Если вы выберите минимум как Pentium II, то вы сможете получить преимущества от дополнительных инструкций, таких как условные перемещения. Так же, в данном случае проще написать кусок кода, который будет поддерживать все платформы. Если вы решили включить поддержку Pentium Plain и MMX CPU, чтобы быть более осведомленным в других вещах, таких как парность команд, различные особенности по предсказанию переходов и т.д. Все это можно изучить в деталях в превосходном руководстве от Agner Fog на сайте http://www.agner.org/assem/, но давайте начнем, ниже несколько основных правил.

2.2.1. Не используйте комплексные команды.

В большинстве случаев, комплексные строковые инструкции очень медленны и должны быть заменены оптимизированным циклом с простыми инструкциями. Без префикса rep, комплексные инструкции вообще за пределами вопроса. Только при определенных специфических условиях инструкции rep movsd и rep stosd могут быть быстрее, но только при условии, что оба адреса, приемник и источник, выровнены на границу восьми байт и при этом не должно быть конфликтов в кэше, и в свете того, что в данный момент Дельфи не дает возможности управлять выравниванием, вы не должны их использовать.

2.2.2. Используйте 32-битные алгоритмы, везде, где только возможно.

Если только невозможно иначе, то вы не должны использовать инструкции, которые оперируют словами, более правильно использовать те, которые работают с переменными типа двойное слово. Байтовый доступ еще может иногда использоваться, но остерегайтесь использовать операции со словами. Ниже пример использования 32-битного алгоритма для поиска символа в строке. Идея основана на генерации уникального значения, если и только если символ найден. Поскольку пример обрабатывает строку по четыре байта за раз, то это значительно быстрее, чем обработка по одному байту за раз, несмотря на дополнительное усложнение, поскольку требуется обрабатывать сразу четыре байта.

Code: Function ScanStrForChar(C: Char; S: String): Integer; register; Asm. Push EBX. Push EDI. Push ESI. Test EDX,EDX. Jz @notfound. Mov ESI,[EDX-4]. Test ESI,ESI. Jz @notfound. Add ESI,EDX. Mov ah,al. Mov di,ax. Shl EDI,16. Or di,ax. Mov EAX,EDX. Lea EDX,[EAX+3]. @L1: Cmp EAX,ESI. Ja @notfound. Mov EBX,[EAX]. Xor EBX,EDI. Add EAX,4. Lea ECX,[EBX-$01010101]. Not EBX. And ECX,EBX. And ECX,$80808080. Jz @L1. Mov EBX,ECX. Shr EBX,16. Test ECX,$8080. Jnz @L2. Mov ECX,EBX. @L2: Lea EBX,[EAX+2]. Jnz @L3. Mov EAX,EBX. @L3: Shl cl,1. Sbb EAX,EDX. Inc EAX. @ending: Pop ESI. Pop EDI. Pop EBX. Ret. @notfound: Xor EAX,EAX. Jmp @ending. End;

Примеры.

Примеры.

В данной главе, мы приведем несколько примеров на basm. Это только первая часть моих статей по Дельфи и встроенному ассемблеру, которая опубликована на данном сайте. Расположено это на странице featured articles, и называется Considerations for writing and using Intel assembly code in Delphi projects (Последнее изменение 1 сентября 2001). Мы будем признательны за замечания или советы по этим страницам.

• Прямой доступ к портам в Windows 95 и 98

• Подсчет количества установленных бит в integer

• Проверка установки отдельного бита (0-31)

• Установка отдельного бита (0-31) в единицу

• Сброс отдельного бита

• Извлечение битовой маски их integer

Есть замечания насчет этих примеров? Пожалуйста, посылайте их по адресу в главе Как связаться с Гуйдо Гайбелсом!

Прямой доступ к портам в Windows 95 и 98.

Code: Function PortInByte(PortAddress: Word): Byte; Asm. Mov dx,ax. In al,dx. End; Procedure PortOutByte(PortAddress: Word; Data: Byte); Asm. Xchg dx,ax. Out dx,al. End;

Как сравнить bookmarks в таблице?

Code: Function TBDEDirect.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Boolean; Var. Res: DBIResult; CompareRes: Word; Begin. Result := False; If CheckDatabase then. Begin. Res := DbiCompareBookmarks(FDataLink.DataSource.DataSet.Handle, Bookmark1, Bookmark2, CompareRes); If Res = 0 then. If CompareRes = 0 then. Result := True. Else. Else. Check(Res); End; End;

TList.

Класс TList.

Класс TList — универсальный список. Он представляет собой массив нетипированных указателей и поэтому годится для хранения набора любых, в том числе разнотипных, данных и объектов. При добавлении/удалении в список данные не создаются и не уничтожаются — эта обязанность лежит на программисте.

Приведем доступные ему методы и свойства класса:

Property Items[Index: Integer]: Pointer; Возвращает указатель на содержимое элемента списка с индексом Index. Это свойство является векторным свойством, принимаемым по умолчанию, и его имя можно при записи опускать.

Property Count: Integer; Определяет число элементов в списке.

Property Capacity: Integer; Определяет максимальное число элементов в списке. Оно может изменяться как явно — пользователем, так и при добавлении элементов в список, в том случае, когда Count>=Capacity. Максимальная емкость списка — 16380 элементов.

Управляют списком следующие методы:

Function Add(Item: Pointer): Integer; Добавляет в конец списка элемент, который будет равен Item (т. е. указывать на те же данные).

Function Remove(Item: Pointer): Integer; Удаляет из списка элемент, который равен Item.

Procedure Insert(Index: Integer; Item: Pointer) ; Вставляет элемент, равный Item, перед элементом с индексом Index.

Procedure Delete(Index: Integer); Удаляет из списка элемент с индексом Index.

Procedure Clear; Очищает список, устанавливая величины Count и Capacity в 0.

Procedure Exchange(Indexl, Index2: Integer); Меняет местами элементы списка с индексами Indexl и Index2.

Function Expand: TList; При соблюдении равенства Count=Capacity расширяет список. При емкости списка менее пяти элементов, он по умолчанию расширяется на четыре элемента, при пяти-восьми — на восемь, более восьми — на шестнадцать.

Function First: Pointer; function Last: Pointer; Возвращают значения первого п последнего (с индексом Count-1) элементов списка соответственно.

Function IndexOf(Item: Pointer): Integer; Возвращает индекс элемента, равного Item.

Procedure Move(CurIndex, Newlndex: Integer) ; Перемещает элемент списка с положения Curlndex в положение Newlndex.

Procedure Pack; Упаковывает список, сдвигая элементы к началу на пустующие места.

Наконец, если приведенных методов почему-либо недостаточно, то свойство.

Property List: pPointerList;

PPointerList = ^TPointerList;

TPointerList = array[0..65520 div SizeOf(Pointer)] of Pointer;

Возвращает указатель непосредственно на список указателен ((ко) означает, что свойство доступно только для чтения).

©Drkb::00316.

TStrings и TStringList.

Класс TStrings.

Многофункциональный класс, предназначенный для хранения текстовых строк и связанных с ними объектов (любых потомков TObject). TStrings — абстрактный класс; он только описывает методы работы с наборами строк и сопутствующих им объектов, но как именно они хранятся, на его уровне не определено. Его потомки очень многочисленны; они играют основную роль в компонентах-списках (TListBox, TComboBox), редакторе (TMemo) и других. Так что вам чаще всего придется иметь дело с TStrings как со свойством одного из компонентов. В дальнейшем экземпляры этого класса и порожденных от него классов мы-будем называть наборами строк. Для создания собственных наборов строк вне компонентов предназначен потомок TStrings — TStringList, который будет рассмотрен ниже.

К строкам и объектам соответственно можно получить доступ через свойства:

Property Strings[Index: Integer]: string;

Property Objects[Index: Integer]: TObject;

Первое из них является векторным свойством, принимаемым по умолчанию. Общее количество пар в списке равно значению свойства:

Property Count: Integer;

Класс TStrings также предназначен для хранения пар вида 'параметр=значение', например, в файлах инициализации (.INI). Эту возможность реализует следующее свойство:

Property Values[const Name: string]: string;

При обращении к этому свойству для чтения ищется строка, содержащая подстроку (параметр) Name и символ '='. Если она найдена, возвращается то, что находится в этой строке после '='. Если нет, ValuesfName] равно пустой строке. При записи: если строка, содержащая параметр Name, найдена — ее значение после '=' заменяется новым значением, если нет — строка добавляется. Если существующему параметру присваивается пустая строка (Valu-es[Name] := ";), то он удаляется из набора строк.

Методы класса.

Procedure BeginUpdate; procedure EndUpdate; Пара процедур, которые устанавливают и сбрасывают флаг обновления набора. Между ними, для ускорения работы, нужно заключать все операции по копированию, удалению и т. д. большого количества элементов.

Procedure Clear; Осуществляет полную очистку набора.

Procedure Insert(Index: Integer; const S: string); Вставляет строку S под индексом Index.

Procedure Delete(Index: Integer); Удаляет строку с индексом Index.

Function IndexOf(const S: string): Integer; Возвращает индекс (номер в наборе) строки S. Если она не найдена, функция возвращает -1.

Function IndexOfObject(AObject: TObject): Integer; Возвращает индекс объекта в наборе. В случае неудачи возвращает -1.

Function Equals(Strings: TStrings): Boolean; Сравнивает строки вызвавшего его объекта со строками объекта Strings и возвращает True в случае равенства (сравниваются число строк и все строки попарно).

Function Add(const S: string): Integer- Добавляет строку S в конец набора и в случае успеха возвращает присвоенный ей индекс (он должен быть равен значению Count до добавления строки).

Function AddObject(const S: string; AObject: TObject): Integer; Добавляет строку в паре с объектом. Возвращает то же, что и метод Add.

Procedure Exchange(Indexl, Index2: Integer); Меняет местами пары строка+объект с индексами Indexl и Index2.

Procedure Move(Curlndex, Newlndex: Integer); Перемещает пару строка+объект с позиции Curlndex в позицию Newlndex.

Procedure InsertObject(Index: Integer; const S: string; AObject: TObject); Вставляет объект AObject и соответствующую ему строку S в набор под индексом Index.

Шесть методов предназначены для экспорта/импорта наборов строк:

А) в поток:

Procedure LoadFromStream(Stream: TStream);

Procedure SaveToStream(Stream: TStream);

Б) в файл (создавая поток и вызывая два предыдущих метода):

Procedure LoadFrornFile (const FileName: strings-procedure SaveToFile(const FileName: string);

В) в данные в формате текстового редактора (подряд расположенные строки, оканчивающиеся парой символов CR/LF (16-ричные коды SOD/SOA)).

Procedure AddScrings(Strings: TStrings); Добавляет в конец набора другой набор Strings.

Procedure Assign(Source: TPersistent); Уничтожает прежнее содержимое набора и подставляет вместо него Source, если источник имеет тип TStrings. В противном случае возникает исключительная ситуация EConvertError.

При этом метод.

Function GetText: PChar;

Выгружает строки в единый массив, где они разделены парами символов CR/LF; в конце такого массива ставится нулевой байт. Размер массива не может превышать 65520 байт; поэтому строки выгружаются до тех пор, пока их суммарная длина не превосходит этого значения.

Метод.

Procedure SetText(Text: PChar);

Читает строки из массива Text. Строки в массиве должны быть отделены друг от друга парой символов CR/LF; допускается и один символ LF (16-ричный код $ОА). Символы с кодами 0, $lA(<Ctrl>+<Z>) воспринимаются как конец текста. При этом прежнее содержимое набора уничтожается.

Класс TStringlist.

Этот класс объединяет в себе свойства TStrings и TList простейшим способом — указатель на объект и соответствующая строка объединяются в запись, указатель на которую хранится в списке. В классе переопределены многие виртуальные методы TStrings: Add, Clear, Delete, Exchange, IndexOf, Insert; он является полностью функциональным и вы можете создавать экземпляры TStringList в своей программе для работы с наборами строк и объектов (помимо тех, которые уже есть в компонентах).

Кроме унаследованных от TStrings, определены дополнительно полезные методы и свойства:

Function Find(const S: string; var Index: Integer): Boolean; Метод ищет в наборе строку S и в случае успеха возвращает результат True, а в параметре Index — ее индекс.

Property Sorted: Boolean; Свойство — признак отсортированности элементов (сортировка осуществляется через посимвольное сравнение строк). Установка Sort := True вызывает процедуру сортировки, которую можно вызвать и явно при помощи метода:

Procedure Sort; Попытка добавить или вставить элемент в отсортированный список вызывает исключительную ситуацию EListError; в этом случае до выполнения действия свойству Sorted нужно присвоить значение False.

Property Duplicates: TDuplicates; TDuplicates = (duplgnore, dupAccept, dupError); Свойство определяет, что происходит при попытке добавить в список дубликат уже имеющейся строки: duplgnore — добавление игнорируется (отклоняется); dupError — добавление приводит к созданию исключительной ситуации EListError; dupAccept — одинаковые строки разрешены. В этом случае при поиске в неотсортированном списке не определено, которая из строк будет найдена первой.

Property OnChange: TNotifyEvent; property OnChanging: TNotifyEvent; Два свойства, предусмотренные для определения пользователем своей реакции на изменение данных. Событие OnChanging вызывается во многих рассмотренных выше методах до внесения первого изменения, OnChange — после последнего.

©Drkb::00317.

Справочник по функциям работы со строками.

Function NewStrtconst(S: String): PString; Создает копию строки S и возвращает указатель на нее.

Procedure DisposeStr(P: PString) ; Уничтожает строку, на которую указывает Р.

Procedure AssignStr(var P: PString; const S: strings) Уничтожает строку, на которую указывает Р и затем присваивает ему адрес созданной копии строки S.

Procedure AppendStrfvar Dest: string; const S: string); Добавляет строку S в конец строки Dest.

Function Uppercase(const S: string): string; Преобразует символы 'a'..'z' в строке S к верхнему регистру.

Function LowerCase(const S: string): string; Преобразует символы 'A'..'Z' в строке S к нижнему регистру.

Function CompareStr(const SI, S2: string): Integer; Сравнивает две строки S1 и S2 с учетом регистра символов. Возвращаемое значение равно 0 в случае равенства строк или разности кодов пары первых несовпадающих символов.

Function CompareText(const SI, S2: string): Integer; Сравнивает две строки без учета регистра символов.

Function AnsiUpperCase(const S: string): string; Преобразует символы в строке к верхнему регистру с учетом языкового драйвера.

Function AnsiLowerCase(const S: string) : string; Преобразует символы в строке к нижнему регистру с учетом языкового драйвера.

Function AnsiCompareStr(const SI, S2: string): Integer; Сравнивает две строки с использованием языкового драйвера и с учетом регистра символов.

Function AnsiCompareText(const SI, S2 : string) : Integer; Сравнивает две строки с использованием языкового драйвера и без учета регистра символов.

Function IsValidldent(const Ident: string): Boolean; Возвращает True, если строка Ident может служить идентификатором в программе на Object Pascal (т. е. содержит только буквы и цифры, причем первый символ — буква).

Function IntToStr(Value: Longint): string; Преобразует целое число в строку.

Function IntToHex(Value: Longint; Digits: Integer): s t r ing ; Преобразует целое число в строку с его шестнадцатиричным представлением.

Function StrToInt(const S: string): Longint; Преобразует строку в целое число. При ошибке возникает исключительная ситуация EConvertError.

Function StrToIntDef(const S: string; Default; Longint): Longint ; Работает как StrToInt, но при ошибке возвращает значение Default.

Function LoadStr(Ident: Word) : string; Загружает строку с индексом Ident из ресурсов приложения.

Function FmtLoadStr(Ident: Word; const Args: array of const): string; Загружает строку с индексом Ident из ресурсов приложения с форматированием (см. описание функции Format).

Справочник по функциям работы с PChar.

Function StrLIComp(Strl, Str2: PChar; MaxLen: Cardinal) : Integer; Работает как StrLComp, но без учета регистра символов.

Function StrScantStr: PChar; Chr: Char) : PChar; Отыскивает первое вхождение символа Chr в строку Str и возвращает указатель на него или nil в случае отстутствия.

Function StrRScanfStr: PChar; Chr: Char) : PChar; Работает как StrScan, но отыскивается последнее вхождение Chr.

Function StrPos(Strl, Str2: PChar) : PChar; Отыскивает первое вхождение строки Str2 в строку Strl и возвращает указатель на нее или nil в случае отстутствия.

Function StrUpperfStr: PChar) : PChar; Преобразует строку к верхнему регистру.

Function StrLower(Str: PChar): PChar; Преобразует строку к нижнему регистру.

Function StrPaslStr: PChar): String; Преобразует строку Str в строку типа string.

Function StrAlloc(Size: Cardinal): PChar; Размещает в куче памяти новую строку размером Size и возвращает указатель на нее.

Function StrBufSize(Str: PChar): Cardinal; Возвращает размер блока памяти, выделенного для строки при помощи функции StrAlloc.

Function StrNewfStr: PChar): PChar ; Размещает в куче памяти копню строки Str и возвращает указатель на нее.

Procedure StrDispose(Str: PChar); Уничтожает строку, размещенную при помощи StrAlloc или StrNew.

Function StrLenfStr: PChar): Возвращает число символов в строке Str (без учета завершающего нулевого).

Function StrEndfStr: PChar): PChar; Возвращает указатель на завершающий нулевой символ строки Str.

Function StrMove(Dest, Source: PChar; Count: Cardinal): PChar; Копирует из строки Source в строку Dest ровно Count символов, причем строки могут перекрываться.

Function StrCopy(Dest, Source: PChar): PChar; Копирует Source в Dest и возвращает указатель на Dest.

Function StrECopy(Dest, Source: PChar): PChar; Копирует Source в Dest и возвращает указатель на завершающий символ Dest.

Function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; Работает как StrCopy, но копирует не более MaxLen символов.

Function StrPCopy(Dest: PChar; const Source: String): PChar; Копирует строку Source (типа string) в Dest и возвращает указатель на Dest.

Function StrPLCopy(Dest: PChar; const Source: string; MaxLen: Cardinal): PChar; Работает как StrPCopy, но копирует не более MaxLen символов.

Function StrCat(Dest, Source: PChar): PChar; Дописывает Source к концу Dest и возвращает указатель на Dest.

Function StrLCatfDest, Source: PChar; MaxLen: Cardinal) : PChar; Работает как StrCat, но копирует не более MaxLen-StrLen(Dest) символов.

Function StrCoirip(Strl, Str2: PChar): Integer; Сравнивает две строки (посимвольно). Возвращает значение: <0 — при Strl <Str2, 0 — при Strl =Str2, >0 — при Strl >Str2.

Function StrIComp(Strl, Str2: PChar): Integer; Работает как StrComp, но без учета регистра символов.

Function StrLComp(Strl, Str2: PChar; MaxLen: Cardinal): Integer; Работает как StrComp, но сравнение происходит на протяжении не более чем MaxLen символов.

Справочник по функциям работы с файлами.

Function File0pen(const FileName: string; Mode: Word) : Integer; Открывает существующий FileName файл в режиме Mode Значение, возвращаемое в случае успеха, — дескриптор открытого файла. В противном случае — код ошибки DOS.

Function FileCreate(const PileName: string): Integer; Создает файл с именем FileName. Возвращает то же, что и FileOpen.

Function FileRead(Handle: Integer; var Buffer; Count: Longint): Longint; Считывает из файла с дескриптором Handle Count байт в буфер Buffer. Возвращает число реально прочитанных байт или -1 при ошибке.

Function FileWrite(Handle: Integer; const Buffer); Записывает в файл с дескриптором Handle Count байт из буфера Buffer. Возвращает число реально записанных байт или -1 при ошибке.

Function FileSeek(Handle: Integer; Offset: Longint; Origin: Integer): Longint; Позиционирует файл с дескриптором Handle в новое положение. При Origin = 1,2,3 положение смещается на Offset байт от начала файла, текущей позиции и конца файла соответственно. Возвращает новое положение или -1 при ошибке.

Procedure FileClose(Handle:Integer) Закрывает файл с дескриптором Handle.

Function FileAge(const FileName:String) Возвращает значения даты и времени создания файла или -1, если файл не существует.

Function FileExists(const FileName:String):boolean; Возвращает True если файл FileName существует к найден.

Function FindFirst(const Path: string; Attr: Integer; var SearchRec: TSearchRec): Integer; Ищет первый файл, удовлетворяющий маске поиска, заданной в Path и с атрибутами Attr. В случае успеха заполняет запись SearchRec (см. примеч. 3) и возвращает 0, иначе возвращает код ошибки DOS.

Function FindNext(var SearchRec: TSearchRec): Integer; Продолжает процесс поиска файлов, удовлетворяющих маске поиска. Параметр SearchRec должен быть заполнен при помощи FindFirst. Возвращает 0, если очередной файл найден, или код ошибки DOS. Изменяет SearchRec.

Procedure FindClose(var SearchRec: TSearchRec); Завершает процесс поиска файлов, удовлетворяющих маске поиска.

Function FileQetDate(Handle: Integer) : Longint; Возвращает время создания файла с дескриптором Handle (в формате DOS) или -1, если дескриптор недействителен.

Procedure FileSetDate(Handle: Integer;) Устанавливает время создания файла с дескриптором Handle (в формате DOS).

Function FileGetAttr(const FileName: string): Integer; Возвращает атрибуты (см. примеч. 2) файла с именем FileName или код ошибки DOS, если файл не найден.

Function FileSetAttrtconst FileName: string; Attr: Устанавливает атрибуты файла с именем FileName.

Function DeleteFile(const FileName:String) Уничтожает файл с именем FileName и в случае успеха возвращает True.

Function RenameFile(const OldName, NewName: string): Boolean; Переименовывает файл с именем OldName в NewName и возвращает True в случае успеха.

Function ChangeFileExt(const FileName, Extension: string): string; Изменяет расширение в имени файла FileName на Extension и возвращает новое значение FileName. Имя файла не изменяется.

Function ExtractFilePath(const FileName: string): string; Извлекает из строки с полным именем файла FileName часть, содержащую путь к нему.

Function ExtractFileName(const FileName: string): string; Извлекает из строки с полным именем файла FileName часть, содержащую его имя и расширение.

Function ExtractFileExt(const FileName: string): string; Извлекает из строки с полным именем файла FileName часть, содержащую его расширение.

Function ExpandFileName(const FileName: string): string; Возвращает полное имя файла FileName, добавляя при необходимости путь к нему и переводя все символы в верхний регистр.

Function FileSearch(const Name, DirList: string): strings- Производит поиск файла с именем Name в группе каталогов, заданных параметром DirList. Имена каталогов должны отделяться друг от друга точкой с запятой. Возвращает в случае успеха полное имя файла или пустую строку, если файл не найден.

Function DiskFree(Drive: Byte): Longint; Возвращает количество в байтах свободного места на заданном диске. Значение параметра Drive: 0 — для текущего диска, 1 — для А, 2 — для В и т. д. Если параметр неверен, функция возвращает -1.

Function DiskSize(Drive: Byte): Longint; Возвращает размер диска Drive в байтах. Параметр Drive означает то же, что и в DiskFree.

Function FileDateToDateTime(FileDate: Longint): TDateTime; Преобразует дату и время в формате DOS в принятый в Delphi формат TDateTime.

Function DateTimeToFileDate(DateTime: TDateTime): Longint; Преобразует дату и время из формата TDateTime в формат DOS.

©Drkb::03180.

Список режимов открытия файлов.

FmOpenRead Открыть только для чтения.

FmOpenWrite Открыть только для записи.

FmOpenReadWrite Открыть для чтения и записи.

FmShareCompat Обеспечить совместимость со старой моделью доступа к файлам.

FmShareExclusive Запретить другим доступ к файлу.

FmShareDenyWrite Запретить другим запись в файл.

FmShareDenyRead Запретить другим чтение файла.

FmShareDenyNone Разрешить другим все виды доступа.

©Drkb::03124.

Функции форматирования строк.

Еще со времен языка FORTRAN у программистов появилась необходимость форматировать строки, направляемые на устройства вывода. Требовался легкий способ для того, чтобы не просто преобразовать число в строку, но также объединить эту строку с другими и включить ее в состав целого предложения.

Функции преобразования чисел с плавающей точкой.

Преобразование числа с плавающей точкой (далее в этом разделе просто числа) в текстовую строку и обратно всегда было достаточно сложной задачей. Для ее решения в Delphi есть функции сразу трех уровней сложности.

Первый — самый простой — представлен функцией FloatToStr:

Внутренний интерфейс Drag and Drop.

Внутренний интерфейс Drag&Drop.

Для библиотеки VCL фирмой Borland реализована собственная версия интерфейса Drag&Drop (переводится как "перетащить"). Интерфейс этот внутренний — передавать и принимать можно любые управляющие элементы Delphi внутри формы' (кроме самой формы). Он реализован без использования соответствующих функций API Windows — их нужно применять при организации общения с другими задачами путем перетаскивания.

Ярлычки и оперативная подсказка.

Ярлычки и оперативная подсказка.

С легкой руки Microsoft, признание получили ярлычки с оперативной подсказкой (Hints). Если задержать курсор, например, над кнопкой или компонентом палитры самой среды Delphi, появляется маленький прямоугольник яркого цвета (окно подсказки), в котором одной строкой сказано о названии этого элемента или связанном с ним действии. Delphi поддерживает механизмы создания и отображения таких ярлычков в создаваемых программах.

Генераторы и их использование.

Генераторы и их использование.

Автор: Дмитрий Кузьменко (http://www.ibase.ru)

Источники: печатная документация и справочная информация по Borland InterBase, переписка листсервера esunix1.

Последние изменения: 2 июля 1999.

Большинство SQL-серверов имеет специальные механизмы для создания уникальных идентификаторов. В Borland Interbase для этого существует механизм генераторов.

В данной статье будут рассмотрены следующие темы:

Создание генераторов.

Использование генераторов в триггерах и хранимых процедурах.

Изменение значения генератора.

Получение текущего значения генератора.

Удаление генераторов.

Нестандартное применение генераторов.

Создание генераторов.

Генератор - это специальный объект базы данных, который генерирует уникальные последовательные числа. Эти числа могут быть использованы в качестве идентификаторов (например код клиента, номер счета и т.п.). Для создания генератора необходимо использовать оператор DDL.

Code: CREATE GENERATOR generatorname;

Перенос приложений с BDE на dbExpress (статья).

Перенос приложений с BDE на dbExpress.

By Bill Todd, President, The Database Group, Inc.

For Borland Software Corporation.

September 2002.

Перевод: by KDV (www.ibase.ru), ноябрь 2002. С разрешения Borland.

Оригинал статьи: http://community.borland.com/article/images/29106/migrating_bde_applications_to_dbexpress.pdf.

Содержание.

1. Borland dbExpress

2. Архитектура dbExpress

3. Как работает архитектура provider/resolver

4. Создание приложений на dbExpress

5. BDE против dbExpress

6. Перенос клиент-серверного приложения BDE на dbExpress

7. Перенос локальных приложений BDE на dbExpress

8. Итог

9. Об авторе

Borland dbExpress.

Прошлые попытки создать универсальный интерфейс для разнообразных БД имели ряд проблем. Одни решения были очень большими, медленными и сложными для распространения, потому что они пытались взять на себя слишком много. Другие предлагали подход "наименьшего общего знаменателя", что не позволяло разработчикам использовать специфические особенности конкретной базы данных. Третьи предлагали комплексный подход с написанием драйверов, получая в результате ограниченную функциональность, низкую скорость или большое количество ошибок.

Borland dbExpress преодолевает эти проблемы, комбинируя новый подход к предоставлению общего API для разных баз данных с проверенной технологией Borland provider/resolver для управления работой с данными. В этом документе рассматривается архитектура dbExpress и механизм provider/resolver, демонстрируется пример создания приложений на компонентах dbExpress, и объясняется процесс переноса на dbExpress приложений, использующих BDE.

Архитектура dbExpress.

DbExpress был разработан, чтобы решить следующие 6 задач.

• минимизировать объем и количество используемых ресурсов

• получить максимальную скорость работы

• обеспечить кросс-платформенность

• обеспечить легкость распространения

• обеспечить легкость разработки драйверов

• дать разработчику больше управления памятью и сетевым трафиком

Драйверы dbExpress небольшие по объему и быстрые, потому что они обеспечивают достаточно небольшую функциональность. Каждый драйвер выполнен в виде dll (на платформе Windows) или как so (shared library на Linux). Драйвер dbExpress предоставляет пять интерфейсов для выборки метаданных, выполнения операторов SQL и хранимых процедур, и возможность чтения записей из выборки в одном направлении (unidirectional cursor). В это же время, при использовании с DataSetProvider и ClientDataSet, dbExpress предоставляет полнофункциональную, высокопроизводительную, многопользовательскую систему для работы с SQL-серверами баз данных.

Как работает архитектура provider/resolver.

Архитектура provider/resolver использует четыре компонента для предоставления данных и их редактирования. Первый компонент - SQLConnection - предназначен для установления соединения между драйвером dbExpress и используемым сервером БД. Дальше идут компоненты, которые предоставляют доступ к данным, получаемым оператором SELECT или вызовом хранимых процедур. Третий компонент - DataSetProvider, и четвертый - ClientDataSet. Когда вы открываете ClientDataSet, он запрашивает данные у DataSetProvider. DataSetProvider открывает компонент, выполняющий запрос или хранимую процедуру, выбирает данные, закрывает этот компонент, и поставляет данные (и необходимые метаданные) компоненту ClientDataSet.

ClientDataSet хранит данные в памяти, пока они просматриваются и модифицируются. При добавлении, удалении или обновлении записи, в коде или через пользовательский интерфейс, компонент ClientDataSet запоминает эти операции в памяти. Для обновления базы данных нужно вызвать метод ClientDataSet.ApplyUpdates. ApplyUpdates передает изменения компоненту DataSetProvider. Провайдер стартует транзакцию, затем создает и выполняет операторы SQL, соответствующие произведенным операциям над данными ClientDataSet. Если все операторы SQL были выполнены успешно, провайдер завершает транзакцию по commit; если нет - отменяет транзакцию по rollback. Изменения в базе данных могут не пройти, например, если изменения нарушают правила контроля данных, или если другой пользователь уже модифицировал эти данные определенным образом. При возникновении ошибки транзакция отменяется по rollback, и вызывается событие ClientDataSet.OnReconcileError, предоставляя вам возможность обработки ошибок.

Преимущества архитектуры provider/resolver.

Короткое время жизни транзакций.

Долгие транзакции заставляют сервер БД удерживать блокировки, которые снижают возможности многопользовательской обработки данных и отнимают ресурсы сервера. При архитектуре provider/resolver, транзакция существует только в тот момент, когда применяются обновления. Это существенно снижает требования к ресурсам и уменьшает вероятность блокировок, особенно при большом количестве пользователей сервера БД.

Дает возможность редактировать любые записи.

Записи, возвращаемые многотабличными выборками, хранимыми процедурами или нередактируемыми view не могут быть изменены напрямую. Вы можете указать при помощи свойства ProviderFlags у объектов TField, какие столбцы должны обновляться, и в событии DataSetProvider.OnGetTableName - какая именно таблица должна обновляться. При этом большинство нередактируемых данных станут редактируемыми.

Быстрая сортировка и поиск.

Поскольку ClientDataSet хранит записи в памяти, они могут быть быстро отсортированы. Если сортировка в памяти работает медленно, вы можете создать индексы над данными ClientDataSet либо во время разработки, либо во время выполнения приложения. Эти индексы в памяти помогут менять порядок записей или искать записи очень быстро, без использования индексов в базе данных.

Автоматическое агрегирование.

ClientDataSet может выполнять автоматически определяемые вами сложные вычисления, такие как Sum(Price) -Sum(Cost). Вы можете группировать вычисления сумм по полю или комбинации полей. Вы также можете использовать агрегаты Min, Max, Count и Avg.

Просмотр подмножества данных.

Выражения фильтрации могут использовать синтаксис WHERE для отображения подмножества записей ClientDataSet, без необходимости конструировать запрос на клиенте и отправлять его каждый раз на сервер.

Множество видов данных.

Возможность "клонировать" курсор ClientDataSet позволяет просматривать одни и те же данные различными способами, одновременно. Например, можно просматривать одни и те же данные, отсортированные по разным столбцам.

Вычисляемые столбцы на клиенте.

Также вы можете добавлять вычисляемые столбцы к ClientDataSet во время разработки, для того чтобы вычисляемые столбцы стали частью данных в памяти. Поскольку вычисления производятся скомпилированным Delphi или C++ кодом, они выполняются очень быстро и могут быть более сложными, чем вычисления, производимые на сервере в COMPUTED BY столбцах.

Ограничение, которого нет.

Может показаться, что у хранения записей в памяти есть ограничение по количеству таких записей, с которыми можно работать. Однако вспомните обычную схему клиент-сервер - приложения разрабатываются таким образом, чтобы выбирать небольшой объем данных для минимизации сетевого трафика и загрузки сервера БД. Даже если нужно работать с необычно большим количеством записей, помните что 10 тысяч записей, каждая по 100 байт, занимают 1 мегабайт памяти. В случаях, когда объем данных действительно большой, компоненты ClientDataSet и DataSetProvider имеют свойства и события, которые позволяют выбирать часть записей, редактировать их, удалять из памяти и затем получать новую порцию записей.

Легкость распространения.

Приложения, использующие dbExpress, для работы требуют две DLL. Первая dll - драйвер dbExpress, например DBEXPINT.DLL для Interbase, и вторая - MIDAS.DLL, библиотека поддержки ClientDataSet. Вместе эти две DLL занимают менее чем 500 килобайт. Это минимизирует размер приложения и упрощает его установку. Если вы не хотите распространять эти DLL, вы можете вкомпилировать их прямо в EXE приложения. Распространение на Linux то же самое, за исключением того, что библиотеки имеют расширение .so, а не .dll.

Легкость создания драйвера.

Драйверы dbExpress должны реализовывать пять интерфейсов, которые описаны в онлайновой справке. Borland также поставляет исходный текст драйвера для MySQL в качестве примера. Это существенно снижает затраты производителей СУБД на создание высокопроизводительных драйверов. Вы можете создать свой собственный драйвер, если вы работаете с необычной или устаревшей базой данных, для которой нет доступных коммерческих драйверов.

Создание приложений на dbExpress.

Перед тем как переносить существующие BDE-приложения на dbExpress, вы должны уметь работать с компонентами dbExpress. В этом разделе мы создадим приложение dbExpress, шаг за шагом, с описанием каждого используемого компонента. Этот пример создан в Delphi на Windows (или C++Builder), но шаги идентичны при работе с Kylix на Linux.

Приложение будет использовать базу данных примеров EMPLOYEE.GDB и отображать отношение один ко многим между таблицами Employee и Salary History. Приложение демонстрирует следующие возможности dbExpress:

• вложенность таблицы деталей в поле главной таблицы

• редактирование данных через SQLQuery, DataSetProvider, и ClientDataSet

• использование SQLQuery как источника данных только для чтения без DataSetProvider и ClientDataSet

• применение изменений, накопленных ClientDataSet, к базе данных

• обработка ошибок при применении изменений к базе данных

Компонент SQLConnection.

Для создания простого приложения dbExpress, начнем со следующих шагов.

1. Создайте новое приложение и добавим data module. Назовем модуль данных MainDm

2. Используйте окно Project Options, для того чтобы убедиться, что модуль создается автоматически перед созданием главной формы

3. Поместите компонент SQLConnection с закладки dbExpress на модуль данных

4. Назовите компонент SQLConnection как EmployeeConnection и установите его свойство DriverName в Interbase

5. Откройте редактор свойств Params и установим параметр Database в путь к EMPLOYEE.GDB

6. Измените значения свойств UserName и Password на нужные

7. Установите свойство LoginPrompt в False, чтобы не появлялось окно запроса имени пользователя и пароля при старте программы

8. Установите свойство Connected в True для проверки соединения, и обратно в False

Компонент SQLConnection обеспечивает соединение с базой данных для любого количества компонент. Вы можете использовать несколько SQLConnection для подсоединения к нескольким базам данных одновременно.

Существует три способа осуществить соединение с базой данных: использовать существующий алиас, создать новый "алиас" или записать параметры соединения прямо в SQLConnection.Properties.

Для создания нового соединения сделайте двойной клик мышью на компоненте SQLConnection, при этом откроется окно Connection Editor. С левой стороны показываются созданные ранее алиасы. Список выбора Driver Name позволяет отфильтровывать нужные алиасы по типам серверов. Сетка Connection Settings показывает список параметров для текущего соединения (они могут отличаться в зависимости от типа драйвера). Все алиасы, которые вы создаете, хранятся в файле dbxconnections.ini.

! если база данных на сервере имеет кодировку WIN1251, то ее нужно указать в свойстве ServerCharSet. Если на сервере в базе данных установлена поддержка кодировки KOI8R, то для Kylix более естественным будет указать ServerCharSet=KOI8R (даже если база данных имеет кодировку WIN1251).

Файл алиасов.

Если вы используете именованные соединения (алиасы), то файл dbconnections.ini можно распространять со своим приложением.

Свойство Params компонента SQLConnection.

При создании нового алиаса нужно выбрать тип сервера в DriverName. Список серверов хранится в файле dbxdrivers.ini. Выбор нужного сервера в DriverName установит свойства LibraryName и VendorLib в значения, соответствующие данному серверу. LibraryName содержит имя драйвера dbExpress, а VendorLib - имя клиентской библиотеки сервера.

После ввода параметров информация о соединении будет хранится внутри приложения. Если вы хотите дать возможность пользователям приложений менять эту информацию, то параметры можно сохранять в своем файле конфигурации, и редактировать его в приложении или отдельной утилитой конфигурации. Это сделает приложение самодостаточным.

У SQLConnection есть методы StartTransaction, Commit и Rollback для явного управления транзакциями. Если нужно вызывать операторы SQL, которые не возвращают набор данных (например, операторы DDL), то можно воспользоваться методами Execute или ExecuteDirect. При этом компоненты для работы с SQL не нужны. Если нужен доступ к метаданным, то вызовите методы GetTableNames, GetFieldNames и GetIndexNames компонента SQLConnection.

Компоненты DataSet.

DbExpress предоставляет четыре компонента: SQLDataSet, SQLQuery, SQLStoredProc и SQLTable. SQLDataSet является универсальным для любых приложений. Установкой свойства CommandType можно выполнять операторы SQL, вызывать хранимые процедуры, или выбирать записи из запросов. Остальные компоненты DataSet созданы для имитации функциональности BDE, насколько это возможно. Использование этих компонент значительно облегчает переход с BDE.

Компонент SQLQuery.

Свойства и методы компонента SQLQuery очень похожи на свойства компонента TQuery BDE. Поскольку SQLQuery возвращает только однонаправленный набор записей, свойства и методы, используемые в BDE для редактирования данных, отсутствуют. Вы можете использовать SQLQuery для выполнения SQL как операторов DML, так и DDL. Для тех операторов, которые возвращают набор записей, можно вызвать метод Open или установить свойство Active в True. Для остальных операторов используйте метод ExecSQL. Продолжим создавать наше приложение:

1. Поместите три компонента SQLQuery на модуль данных

2. установите их свойство SQLConnection в EmployeeConnection

3. Назовите первый компонент EmployeeQry, второй HistoryQry, и третий - DeptQry

4. Установите свойство SQL компонента EmployeeQry в

select * from employee

where dept_no = :dept_no

order by last_name

5. Установите свойство SQL компонента HistoryQry в

select * from salary_history

where emp_no = :emp_no

6. Установите свойство SQL компонента DeptQry в

select dept_no, department from department

order by department

7. Поместите компонент DataSource на модуль данных, установите его имя в EmpLinkSrc, а свойство DataSet - в EmployeeQry

8. Установите свойство компонента HistoryQry.DataSource в EmpLinkSrc

9. Вернитесь к EmployeeQry, откройте редактор свойства Params, и установите значение параметра dept_no в XXX. Поскольку это неверное значение, в результате не будет отображено ни одной записи, пока пользователь не введет правильный номер отдела.

10. Сделайте двойной клик на EmployeeQry, для того чтобы открыть Fields Editor. Добавьте все поля (в меню по правой кнопке add all fields)

11. Выберите столбец emp_no, свойство ProviderFlags, и установите pfInKey в True. Установка этого флага указывает на то, что столбец emp_no является первичным ключом. Компоненту DataSetProvider (который мы добавим позже) нужна эта информация для генерации операторов SQL, модифицирующих данные.

12. Выберите столбец full_name, свойство ProviderFlags, и установите pfInUpdate и pfInWhere в False. Столбец full_name является вычисляемым полем, поэтому не может быть обновлен и не нужен в условии where SQL операторов, генерируемых DataSetProvider.

13. Установите свойство Active компонента EmployeeQry в True

14. Сделайте двойной клик на HistoryQry, и в FieldEditor добавьте все поля (add all fields)

15. Выберите поле emp_no и установите pfInKey в True. Повторите то же самое для полей change_date и updater_id, т.к. все эти три поля являются первичным ключом.

16. Поле new_salary также является вычисляемым, поэтому для него тоже нужно установить pfInUpdate и pfInWhere в False

17. Установите свойство Active компонента EmployeeQry в False

18. Сделайте двойной клик на компоненте DeptQry, добавьте все поля (add all fields)

19. установите свойство Connected компонента EmployeeConnection в False

Компонент SQLTable.

Этот компонент очень похож на TTable из BDE. Как и в BDE, этот компонент возвращает все столбцы и все записи из таблицы, поэтому он не очень подходит для приложений клиент-сервер. Его единственное преимущество только в том, что его использование позволяет быстро перевести на dbExpress приложения, которые используют TTable.

Для использования SQLTable нужно установить свойство SQLConnection в имя компонента SQLConnection, затем указать в TableName имя нужной таблицы, и открыть компонент методом Open или установкой свойства Active в True.

Компонент SQLStoredProc.

Этот компонент предназначен для вызова хранимых процедур, и может быть использован, так же как и компонент TStoredProc BDE. Процедуры можно вызывать и компонентом SQLDataSet (и SQLQuery).

Для использования компонента установите свойство SQLConnection в имя соответствующего SQLConnection, и укажите в StoredProcName имя процедуры. Если процедура возвращает набор записей, то открыть ее можно методом Open или установкой свойства Active в True. Если процедура не возвращает набор записей, выполнить ее можно методом ExecProc.

Компонент SQLDataSet.

Для использования SQLDataSet подсоедините его к выбранному SQLConnection. Далее, установите свойство CommandType в один из трех вариантов - ctQuery, ctStoredProc или ctTable. Чаще всего вы будете использовать ctQuery. Значение свойства CommandText зависит от установленного CommandType. Если CommandType равен ctQuery, то CommandText должно содержать текст выполняемого запроса SQL. При ctStoredProc CommandText должен содержать имя хранимой процедуры. При ctTable CommandText должен содержать только имя таблицы. Свойство Params используется для параметризованных запросов или процедур. Свойство DataSource предназначено для связывания с другими SQLDataSet, например, для организации связки мастер-деталь.

Если запрос возвращает набор записей, то SQLDataSet открывается методом Open или установкой Active в True. Если нет - запрос выполняется методом ExecSQL.

Компонент SQLDataSet обеспечивает перемещение по записям только в одном направлении. Если этого достаточно, например, для печати отчета, то можно использовать SQLDataSet с DataSource. Если же нужно обеспечить возможность навигации по записям как вниз, так и вверх, или редактировать записи, то нужно добавить DataSetProvider или использовать SimpleDataSet, как это описано дальше в этом документе.

При необходимости получения более подробной информации о метаданных, чем ее предоставляет SQLConnection, можно использовать метод SQLDataSet.SetSchemaInfo. Этот метод принимает три параметра - SchemaType, SchemaObject и SchemaPattern. SchemaType может быть stNone, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, или stIndexes. Этот параметр определяет тип информации, которую будет выводить SQLDataSet при открытии. Если выполняется обычный запрос, то всегда указано stNone. Остальные типы схем открывают выборку с соответствующими полями и возвращаемой информацией. SchemaObject - имя хранимой процедуры или таблицы, когда идет запрос информации об этом объекте. SchemaPattern - маска для фильтрации результата запроса. Например, если SchemaType = stTables и SchemaPattern = 'EMP%', то набор данных будет содержать информацию только о тех таблицах, имя которых начинаются с 'EMP'.

Компонент SimpleDataSet.

Для просмотра и редактирования записей в BDE достаточно использовать компонент TQuery. В dbExpress необходимо использовать комбинацию SQLQuery или SQLDataSet, DataSetProvider и ClientDataSet, соединенных вместе. Есть два способа сократить время на добавление этих трех компонент и установку их свойств.

Компонент SimpleDataSet введен в Delphi 7. Он комбинирует в себе SQLDataSet, DataSetProvider и ClientDataSet. Если вам нужен компонент для просмотра и редактирования данных одной таблицы, то просто добавьте компонент SimpleDataSet на модуль данных, и установите свойства CommandType и CommandText. Однако SimpleDataSet имеет ряд ограничений:

• вы не можете использовать его в многозвенных приложениях. Если в дальнейшем потребуется конвертировать приложение в многозвенное, используйте отдельные компоненты

• невозможно подсоединить дочерний DataSet

• События встроенного DataSetProvider не экспортированы

• Свойство Options встроенного DataSetProvider не экспортировано. Вы не можете устанавливать параметры провайдера во время разработки или выполнения

• Вы не можете определять поля встроенного DataSet в момент разработки. Это означает, что вы не можете установить свойство ProviderFlags во время разработки. Вам придется делать это в коде приложения

• Если вы используете Borland MyBase (база данных встроенная в ClientDataSet), и не работаете с сервером баз данных, то лучше использовать ClientDataSet отдельно, для уменьшения используемых ресурсов

• Свойства и методы встроенного SQLDataSet не эквивалентны свойствам TQuery. Поэтому использование SimpleDataSet при переносе проектов с BDE могут потребовать больше изменений в коде

Если нужно больше функциональности, чем предлагает ClientDataSet, то поместите компоненты SQLQuery, DataSetProvider и ClientDataSet на форму или модуль данных. Установите свойство DataSetProvider.DataSet на SQLQuery. Установите ProviderName на ClientDataSet. Выберите все три компонента, и в главном меню среды выберите - Component | Create Component Template. Укажите имя класса, компонента и палитры для нового шаблона. Теперь можно бросить три компонента на модуль данных так же легко как один компонент.

SQLMonitor.

Этот компонент предназначен для оптимизации производительности ваших приложений. SQLMonitor контролирует все операторы SQL, передаваемые компонентом SQLConnection серверу баз данных. Информация может быть сохранена в файл, компонент TMemo, или обработана любым другим способом.

Компоненты доступа к данным.

При необходимости прокрутки записей и обновления данных, нужно использовать компоненты DataSetProvider и ClientDataSet.

DataSetProvider.

Этот компонент связывается с компонентами DataSet через одноименное свойство. DataSetProvider поставляет данные компоненту ClientDataSet и генерирует операторы SQL DML для обновления базы данных, используя лог изменений, накапливаемый ClientDataSet.

Вернемся к модулю данных нашего приложения, и проделаем следующие шаги:

1. Добавьте DataSetProvider с палитры DataAccess на модуль данных

2. Его свойство DataSet установите в EmployeeQry, а имя (name) в EmployeeProv

Свойство UpdateMode позволяет управлять, каким образом провайдер определяет, изменена ли запись другим пользователем. Когда провайдер генерирует операторы SQL для обновления базы данных, каждый оператор UPDATE или DELETE включает условие WHERE для идентификации записи. Если UpdateMode установлен в upWhereAll, оригинальное значение каждого не-блоб поля в записи будет включено в условие WHERE, за исключением тех полей, у которых в ProviderFlags установлено pfInWhere=False. Это означает, что выполняемый оператор UPDATE или DELETE выдаст сообщение об ошибке, если на сервере любое из полей данной записи было изменено. upWhereChanged включает в WHERE только измененные поля. При upWhereKeyOnly генерируется WHERE, включающий только поля первичного ключа.

Свойство Options содержит много флагов, позволяющих управлять процессом provide/resolve. Если poCascadeDeletes установлено в True, то провайдер не будет генерировать операторы SQL для удаления записей в таблице деталей при удалении записей в мастер-таблице. Провайдер будет предполагать, что сервер баз данных поддерживает каскадное удаление, и удалит записи деталей самостоятельно. poCascadeUpdate обеспечивает аналогичную функциональность при изменении первичного ключа мастер-таблицы.

Если SQLQuery, поставляющий данные провайдеру, содержит запрос с ORDER BY, и вы хотите сохранить этот порядок в ClientDataSet, установите флаг poRetainServerOrder в True. Если нужно иметь возможность менять текст запроса SQLQuery путем изменения свойства ClientDataSet.CommandText - установите poAllowCommandText в True.

Если используется обработчик событий BeforeUpdateRecord, и он может изменить значение поля в записи, перед тем как обновление будет отправлено на сервер, установите poPropogateChanges в True. Теперь провайдер будет отсылать изменения обратно в ClientDataSet для обновления записей, хранимых в памяти.

Из множества полезных событий компонента DataSetProvider стоит отметить наиболее важные - OnGetTableName и BeforeUpdateRecord. В многотабличных запросах, хранимых процедурах или нередактируемых view невозможно модифицировать записи напрямую. DataSetProvider предоставляет три инструмента для обработки таких ситуаций.

Если запись включает столбцы из одной таблицы, например возвращаемые хранимой процедурой, единственной проблемой является то, что DataSetProvider не в состоянии определить, какую таблицу надо обновлять. Решение кроется в создании обработчика OnGetTableName, чтобы это событие возвращало имя таблицы.

Другая возможность есть для обновления многотабличных выборок, где надо обновлять записи только одной таблицы. Вначале, установите ProviderFlags конкретных полей для указания, что именно эти поля надо обновлять. Потом создайте OnGetTableName, возвращающий имя нужной таблицы. После этого провайдер будет генерировать операторы SQL для обновления таблицы автоматически. Если нужно обновлять много таблиц для каждой записи, то добавьте событие BeforeUpdateRecord, в котором можно создавать операторы SQL для каждой таблицы и выполнять их.

Обработчик BeforeUpdateRecord также дает возможность проверять запись перед ее обновлением, и изменять значения полей. Можно вообще заблокировать изменение путем вызова excepton. Это делает BeforeUpdateRecord хорошим местом для применения бизнес-правил.

ClientDataSet.

ClientDataSet подсоединяется к DataSetProvider через свойство ProviderName. Он получает данные из DataSetProvider, буферизирует данные в памяти, регистрирует все изменения данных, и отправляет лог изменений в DataSetProvider при вызове ClientDataSet.ApplyUpdates.

Продолжим работу над примером приложения:

1. Поместите два компонента ClientDataSet на модуль данных

2. установите свойство ProviderName первого компонента на EmployeeProv, и назовите его EmployeeCds

3. сделайте двойной клик на EmployeeCds, чтобы открыть FieldEditor. Выполните Add all fields. Последнее поле имеет имя HistoryQry. Это поле вложенного DataSet, которое содержит историю зарплат (salary history) для каждой записи о сотруднике (employee). Записи, возвращаемые HistoryQry видны как вложенные данные внутри данных EmployeeQry. Это происходит потому, что свойство HistoryQry.DataSource установлено в EmpLinkSrc, который подсоединен к EmployeeQry, и получает значение параметра запроса из записи EmployeeQry.

4. Щелкните правой кнопкой мыши на EmployeeCds и выберите пункт меню FetchParams, чтобы ClientDataSet обновил список параметров в соответствии с компонентом EmployeeQry.

5. Назовите второй ClientDataSet как HistoryCds и установите его свойство DataSetField в EmploueeCdsHistoryQry. Теперь HistoryCds будет получать данные из поля вложенного набора данных EmployeeCds

6. Сделайте двойной клик на HistoryCds, и в Field Editor добавьте все поля (add all fields)

7. Поместите два компонента DataSource на модуль данных. Назовите их EmployeeSrc и HistorySrc.

8. Установите свойство DataSet у этих компонент - у EmployeeSrc в EmployeeCds, и у HistorySrc в HistoryCds.

Теперь можно установить свойство Active в True у компонент EmployeeCds и HistoryCds. Модуль данных при этом будет выглядеть следующим образом:

Вложенные наборы данных - весьма мощная вещь, поскольку они исключают непонимание порядка обновлений данных мастер- и деталь-таблицы. Например, если добавлены несколько записей в таблицу-мастер и несколько записей в таблицу деталей, то INSERT в таблицу-мастер должен быть отправлен на сервер БД раньше, чем INSERT в таблицу деталей. И наоборот, если удаляются записи деталей, а затем записи мастера, то оператор DELETE должен выполняться именно в таком порядке. При вложенных наборах данных DataSetProvider обеспечивает правильный порядок следования запросов на обновление, что исключает ошибки на сервере БД.

ClientDataSet имеет ряд полезных свойств. Свойство Aggregates позволяет определить агрегатные столбцы, которые автоматически будут считать сумму, минимум, максимум, количество или среднее значение любого числового столбца набора данных. Агрегаты могут быть сгруппированы по любому индексу. Свойство AggregatesActive позволяет управлять состоянием агрегатов в момент выполнения.

Для сортировки записей в нужном порядке, укажите в свойстве IndexFieldNames имена полей сортировки, разделенные точкой с запятой. Для сортировки по убыванию или для ускорения сортировки создайте индекс по нужным полям, и укажите имя этого индекса в свойстве IndexName.

Используйте свойство CommandText для изменения запроса SQL в компоненте, который поставляет данные DataSetProvider. Закройте ClientDataSet, назначьте новый запрос в CommandText, и откройте ClientDataSet для получения результата нового запроса. Также можно назначать новые значения параметрам в источнике записей, используя свойство ClientDataSet.Params.

Почему желательно использовать CommandText и Params вместо обращения к конкретным свойствам компонента, поставляющего данные (например, SQLQuery)? Дело в том, что при таком написании кода его не придется менять, если впоследствии потребуется переписать приложение на многозвенную архитектуру (Borland DataSnap).

Свойство PacketRecords позволяет управлять количеством записей, которое провайдер выбирает с сервера за одно обращение. Значение по умолчанию -1 указывает провайдеру выбирать все записи, возвращаемые компонентом, выполняющим SQL-запрос. Обычно это нормально, но если нужно обработать большое количество записей, то может потребоваться выбирать их небольшими группами.

Одно из самых больших отличий BDE и архитектуры provider/resolver в том, что вы должны вызывать ClientDataSet.ApplyUpdates для применения изменений к базе данных. Используйте свойство ChangeCount для проверки наличия неотправленных изменений. ApplyUpdates имеет один параметр, который указывает допустимое количество ошибок, после которого процесс обновления будет прерван, и транзакция будет отменена по rollback. Обычно передается 0, поэтому процесс обновления прерывается при первой же ошибке. Передача -1 указывает на необходимость отправки всех изменений, независимо от количества возникающих ошибок.

Если при обновлении данных возникает ошибка, происходит событие ClientDataSet.OnReconcileError. Для обработки ошибок в нашем приложении-примере сделайте следующее:

1. Добавьте в проект Reconcile Error Dialog с закладки Dialogs репозитария объектов

2. Добавьте имя нового модуля в оператор USES модуля данных.

3. В свойствах проекта убедитесь, что модуль Reconcile Error Dialog не создается автоматически при запуске приложения

4. Создайте обработчик OnReconcile для EmployeeCds, и добавьте туда строку

Action := HandleReconcileError(DataSet, UpdateKind, E);

Если в момент применения изменений возникнет ошибка, то будет показан диалог Reconcile Error, в нем отображены записи, приведшие к сообщению об ошибке, и набор кнопок, которые дают пользователю возможность обработать ошибку.

Чтобы завершить приложение, проделайте следующее:

1. Добавьте два компонента Panel, два DBGrid и два DBNavigator на главную форму приложения, так как это показано на картинке

2. Добавьте имя модуля данных в USES главной формы

3. Установите свойство DataSource верхнего DBGrid и DBNavigator в EmployeeSrc

4. Установите свойство DataSource нижнего DBGrid и DBNavigator в HistorySrc

5. Добавьте Label и ComboBox

6. Создайте событие OnChange для ComboBox со следующим текстом

procedure TMainForm.DeptComboChange(Sender: TObject);

begin

with MainDm.EmployeeCds do

begin

if Active then CheckBrowseMode;

Close;

Params.ParamByName('DEPT_NO').asString :=Copy(DeptCombo.Text, 1, 3);

Open;

end; //with

end;

Добавьте кнопку (Button) на верхнюю панель, и установите ее надпись в "Сохранить".

1. Добавьте следующий код по OnClick для этой кнопки

Procedure TForm1.SaveBtnClick(Sender: TObject);

Begin.

With MainDm do.

Begin.

If EmployeeCds.ChangeCount > 0 then.

Begin.

If HistoryCds.Active then.

HistoryCds.CheckBrowseMode;

If EmployeeCds.Active then.

EmployeeCds.CheckBrowseMode;

EmployeeCds.ApplyUpdates(0);

EmployeeCds.Refresh;

End; //if.

End; //with.

End;

Добавьте метод к форме MainForm для заполнения списка выбора номеров отделов.

Procedure TMainForm.LoadDeptCombo;

Begin.

With MainDm do.

Begin.

DeptQry.Open;

While not DeptQry.Eof do.

Begin.

DeptCombo.Items.Add(DeptQryDept_No.asString +

' ' + DeptQryDepartment.asString);

DeptQry.Next;

End; // while.

DeptQry.Close;

End; // with.

End;

Добавьте обработчик OnCreate для главной формы.

Procedure TMainForm.FormCreate(Sender: TObject);

Begin.

MainDm.EmployeeCds.Open;

LoadDeptCombo;

End;

Приложение готово, можно запускать.

BDE против dbExpress.

В таблице приведено сравнение BDE и dbExpress по ряду параметров, для того чтобы привести список отличий. Вторая таблица показывает компоненты dbExpress, соответствующие компонентам BDE.

Функциональность BDE dbExpress.

Буферизация записей BDE сам определяет количество записей, хранимых в памяти Вы можете управлять количеством записей, хранимых в памяти.

Контроль сетевого трафика BDE сам определяет, сколько записей выбирать с сервера Вы управляете как количеством, так и моментом выборки записей с сервера.

Управление транзакциями Есть автоматический режим и ручное управление транзакциями. Транзакции активны в момент редактирования данных. Есть автоматический режим и ручное управление транзакциями. Транзакции активны в момент передачи изменений на сервер.

Распространение приложений Большое количество файлов (объемом около 9 мегабайт). Установка и конфигурирование достаточно сложны и требуют редактирования registry. Для распространения нужно две dll, занимающие менее 500 килобайт, которые могут быть вкомпилированы в EXE. Конфигурация хранится в dbxconnections.ini и dbxdrivers.ini.

Кросс-платформенность Только Windows Windows и Linux.

Драйверы от третьих фирм Сложно разрабатывать, практически нет Легко разрабатывать. Доступно много разных драйверов. За информацией по драйверам обращайтесь на bdn.borland.com.

Следующая таблица показывает компоненты dbExpress, которые соответствуют компонентам BDE. Обратите внимание, что в dbExpress нет аналога компоненту BatchMove из BDE.

BDE dbExpress.

TDatabase TSQLConnection.

TQuery TSQLQuery.

TStoredProc TSQLStoredProc.

TTable TSQLTable.

Нет аналога TSQLDataSet.

TBatchMove нет аналога.

Утилита SQL Monitor TSQLMonitor.

TSession нет.

TUpdateSQL нет.

NestedDataSet нет.

BDEClientDataSet SimpleDataSet.

Механизм TSession отсутствует в dbExpress, и как таковой в dbExpress не нужен. TUpdateSQL используется только при включении CachedUpdates компонента TQuery. в dbExpress, возможности ClientDataSet заменяют cached updates. Возможность обработки вложенных наборов данных встроена в DataSetProvider и ClientDataSet.

Перенос клиент-серверного приложения BDE на dbExpress.

Перенос приложений BDE на dbExpress требует выполнения ряда шагов. Многие приложения клиент-сервер не используют компонент TTable. Поскольку локальные приложения BDE интенсивно используют TTable, эта тема описана в следующем разделе.

• Замените компонент TDatabase на компонент SQLConnection

• Замените компоненты TQuery и TStoredProc на компоненты SQLQuery и SQLStoredProc

• добавьте DataSetProvider и ClientDataSet к каждому SQLQuery или SQLStoredProc, для которых требуется двунаправленная прокрутка или редактирование данных

Замена TDatabase на SQLConnection.

Каждый компонент BDE TDatabase должен быть заменен на SQLConnection.

Установка параметров соединения.

Если вы используете алиасы BDE, то будет нужен соответствующий алиас для SQLConnection. Наиболее удобный вариант - это хранить параметры коннекта в ini-файле. При этом нужно соответствующим образом запрограммировать чтение параметров из ini-файла в SQLConnection.Params при старте приложения.

Управление транзакциями.

Одно из ключевых решений, которые нужно принять перед конвертированием приложений, это как управлять транзакциями. Если ваше приложение BDE никак не управляло транзакциями, т.е. полагалось на автоматический контроль транзакций, то все что это нужно делать - обеспечить вызовы ApplyUpdates в тех местах, где нужно сохранять данные. dbExpress будет управлять транзакциями, так же как и BDE. Если пользователь продолжит работу с тем же набором данных после применения обновления, нужно вызвать метод ClientDataSet.Refresh. Это приведет к повторному выполнению запроса, и помещению новых данных в ClientDataSet. Это позволит пользователю видеть чужие изменения в базе данных.

Если ваше приложение использовало явное управление транзакциями, т.е. вызывало методы StartTransaction, Commit и Rollback, выбор становится более сложным. Один вариант это убрать весь код, управляющий транзакциями, и заменить каждый вызов Commit вызовом ApplyUpdates соответствующих ClientDataSet. При этом dbExpress будет управлять транзакциями самостоятельно, и упростит код. Однако это не будет работать, если изменения двух ClientDataSet надо применить в одной транзакции. Явные вызовы Rollback надо заменить на вызов ClientDataSet.CancelUpdates. CancelUpdates отменяет накопленные в логе изменения ClientDataSet.

Другой вариант - оставить операторы явного управления транзакциями. Это наиболее сложный вариант по трем причинам:

• Вы должны добавить вызовы ApplyUpdates перед каждым Commit (и CancelUpdates при Rollback)

• Вы должны перенести место вызова StartTransaction если хотите получить преимущества коротких транзакций (возможно, перед соответствующими ApplyUpdates)

• При каждом вызове StartTransaction, Commit и Rollback нужно передавать параметр TTransactionDesc

Как видите, меньше работы при удалении кода, явно управляющего транзакциями, чем при его модификации. Давайте посмотрим на эти три пункта подробнее.

После старта транзакции и перед каждым Commit вам нужно добавить вызовы ApplyUpdates всех ClientDataSet, которые участвуют в транзакциях. До вызова ApplyUpdates никакие изменения в базу данных не попадут, поэтому делать Commit не имеет смысла.

В клиент-серверных приложениях BDE управление транзакциями выглядит следующим образом:

1. Старт транзакции

2. Редактирование данных пользователем

3. Commit или Rollback

В этой модели транзакция активна все время, пока пользователь редактирует данные. Одно из главных достоинств dbExpress это короткое время жизни транзакций. Для использования этого достоинства управление транзакциями должно быть изменено на следующую схему:

1. Пользователь редактирует данные в ClientDataSet

2. Старт транзакции

3. Вызов ApplyUpdates

4. Commit или Rollback

Для изменения приложения в соответствии с этой схемой, нужно переместить каждый вызов StartTransaction в место, где будет выполняться соответствующий Commit. Затем между ними вставить вызов ApplyUpdates.

Компоненты TDatabase и SQLConnection имеют методы StartTransaction, Commit и Rollback. В отличие от BDE dbExpress позволяет работать с несколькими транзакциями, активными в один и тот же момент. Для поддержки такого режима методы StartTransaction, Commit и Rollback принимают параметр TTransactionDesc. Он объявлен как:

TTransactionDesc = packed record.

TransactionID : longword;

GlobalID : longword;

IsolationLevel : TTransactionIsolationLevel;

CustomIsolation: longword;

End;

Для каждой отдельной транзакции вы должны объявить переменную типа TTransactionDesc и установить TransactionId в число, которое должно быть уникально между всеми активными транзакциями. Поле GlobalId используется только в Oracle. IsolationLevel может быть xilDirtyRead, xilReadCommitted или xilRepeatableRead. Поле CustomIsolation пока не поддерживается.

Поскольку BDE не поддерживает более одной одновременной транзакции, все, что вам нужно это объявить одну переменную типа TTransactionDesc в интерфейсной части модуля, который используется всеми остальными модулями приложения (которые используют явные транзакции). В коде, обрабатываемом при старте приложения, установите TransactionID этой переменной в 1, а IsolationLevel в xilReadCommitted или xilRepeatableRead. Далее, измените все вызовы StartTransaction, Commit и Rollback на вызовы, принимающие эту переменную как параметр.

Замена всех компонент DataSet.

Самая большая работа - это замена всех компонент DataSet при конвертации приложения. Вы должны заменить все TQuery на SQLQuery и все TStoredProc на TSQLStoredProc. Процесс усложняется тем, что компоненты BDE имеют ряд свойств, которых нет у компонент dbExpress. Все ссылки на отсутствующие свойства и методы в коде должны быть убраны.

Для каждого SQLQuery и SQLStoredProc, требующего двунаправленной прокрутки и возможности редактирования данных, вы должны добавить DataSetProvider и ClientDataSet. Подсоедините обработчики событий, которых нет у SQLQuery и SQLStoredProc, к ClientDataSet. Для минимизации изменений в коде именуйте компоненты ClientDataSet как заменяемые ими TQuery в BDE.

Далее, вернитесь к компонентам SQLQuery и SQLStoredProc, и инициализируйте их столбцы, используя Fields Editor. Установите необходимые ProviderFlags для полей первичного ключа (pdInKey) и обновляемых (или не обновляемых) полей (pfInUpdate и pfInWhere).

Могут быть случаи, когда добавление DataSetProvider и ClientDataSet не требуется. Например, у вас есть запрос, записи которого читаются один раз от первой до последней записи, и записываются в ComboBox или ListBox. В этом случае, поскольку вы сканируете записи в одном направлении, и ничего кроме доступа только для чтения не требуется, вы можете использовать SQLQuery или SQLStoredProc самостоятельно.

Если вы используете CachedUpdates в BDE, удалите все компоненты UpdateSQL. CachedUpdates не нужны в dbExpress, поскольку ClientDataSet и DataSetProvider обеспечивают ту же самую функциональность.

И, наконец, не забудьте добавить вызовы ClientDataSet.ApplyUpdates как это описано в предыдущей части этого документа.

Отображение типов данных.

DbExpress использует два новых типа данных, с которыми вы не сталкивались при работе с BDE. Все числовые значения, которые не вмещаются в double precision, будут помещаться в объект TFMTBCDField. Объект TFMTBCDField хранит данные как тип TBCD, являющийся настоящим числом BCD (binary coded decimal) с максимальной точностью в 32 цифры. Для выполнения математических операций над значением в этом типе столбца используйте свойство asVariant.

DbExpress использует TSQLTimeStampField для хранения данных даты и времени. Этот тип хранит данные в переменной типа TSQLTimeStamp. Это запись Delphi, с отдельными полями для года, месяца, дня, часов, минут, секунд и миллисекунд. TSQLTimeStamp позволяет хранить информацию о дате и времени без потерь.

TSQLTimeStampField имеет методы as.... для конвертации даты и времени в другие типы данных.

Замена TBatchMove.

В dbExpress нет аналога компонента BDE BatchMove. Если вы используете этот компонент в своих приложениях, то его придется заменить вручную написанным кодом.

Перенос локальных приложений BDE на dbExpress.

Если вы переносите на dbExpress приложения, работающие с локальными форматами данных Paradox или dBase, вы столкнетесь с рядом проблем.

Конвертация данных.

Поскольку dbExpress не поддерживает таблицы Paradox или dBase, вам придется установить SQL-сервер, поддерживаемый dbExpress, и перенести туда все данные. Есть три способа сделать это.

• Используйте утилиту DataPump, входящую в поставку Delphi или C++Builder

• Используйте утилиты переноса данных третьих фирм (kdv - например IBDataPump)

• Напишите свою утилиту, переносящую данные из одного формата в другой

Используемый SQL сервер может не поддерживать все типы данных Paradox или dBase. Например, в Paradox есть тип boolean, который есть не во всех SQL-серверах (kdv - boolean есть в Interbase 7). Также нужно убедиться, что утилита копирования данных правильно соотносит типы данных источника и приемника.

Многие SQL-серверы поддерживают как CHAR, так и VARCHAR, в то время как в настольных СУБД поддерживается один строковый тип. Проверьте, может ли утилита конвертирования указывать на стороне приемника нужный тип для строк.

Вам может потребоваться изменить типы данных по другим причинам. Например, Paradox хранит числа с плавающей точкой только в double. Большинство серверов SQL поддерживают также фиксированный формат, такой как NUMERIC или DECIMAL. В отличие от чисел с плавающей точкой числа с фиксированной точкой не имеют проблем с округлением, однако теряют точность при вычислениях, если таковая требуется более определенной. Опять же, проверьте утилиту конвертирования данных, может ли она выбирать на стороне приемника типы для хранения числовых данных.

Безопасность сервера.

Вы не можете получить доступ к данным SQL-сервера, пока не введете правильное имя пользователя и пароль. Возможно, для вашего приложения все пользователи будут иметь одно и то же имя пользователя и пароль, или наоборот, пользователи будут указывать свое имя при старте приложения. Во втором случае придется в код приложения добавлять обработку прав доступа.

Многие настольные форматы данных поддерживают шифрование файлов данных с целью исключения возможности кражи данных. Однако многие SQL-серверы этого не позволяют. Вместо этого они ориентируются на функциональность операционной системы, обеспечивающей безопасность доступа к файлам. Обычно пользователь, которому требуется доступ ко всем данным, является администратором. Для этой цели в SQL-серверах существуют специальные учетные записи. Если же ваше приложение будет работать в "однопользовательском" режиме, например на ноутбуке, убедитесь, что выбранная СУБД обеспечивает нужный уровень безопасности.

Концепция "набора данных".

Обычные настольные приложения позволяют пользователям работать с таблицами целиком, через компонент Table. Этот подход может вызвать серьезные проблемы с производительностью при переходе на SQL-сервер, потому что в этом случае вся таблица должна быть выбрана с сервера в клиентское приложение. Компонент Table также вызывает большой трафик, принимая с сервера различные метаданные, именно поэтому Table и может самостоятельно конструировать запросы на выборку и обновление данных.

Хранение записей в памяти ClientDataSet не является проблемой в правильно спроектированном приложении client-server, поскольку приложение выбирает небольшое количество записей за один раз с сервера. В любом случае, перенос приложения, позволяющего пользователям просматривать таблицы целиком, может вызвать большой расход памяти на клиентской стороне, т.к. вся таблица будет храниться в памяти ClientDataSet.

Когда вы конвертируете приложение, использующее компонент Table, у вас есть три возможности.

1. заменить каждый Table компонентами SQLTable, DataSetProvider и ClientDataSet

2. заменить каждый Table компонентами SQLQuery, DataSetProvider и ClientDataSet. Выбирать все столбцы и все записи из таблицы.

3. заменить каждый Table компонентами SQLQuery, DataSetProvider и ClientDataSet. Переписать приложение для работы в client-server.

Вариант 1 является наиболее простым, т.к. свойства SQLTable почти целиком повторяют свойства Table. Если таблицы не очень большие, то производительность будет достаточной. Недостаток этого варианта в том, что если вы захотите выбирать часть данных с сервера вместо всех данных, вам придется заменить компонент SQLTable на SQLQuery.

Второй вариант более правильный. Даже если вы будете выбирать все столбцы и все записи, ваше приложение теперь будет выполнять указанные вами запросы. Все что нужно будет сделать в дальнейшем, это изменить приложение на работу с наборами записей.

Третий вариант потребует изменения части кода. Приложения, которые созданы для работы в client-server, обычно заставляют пользователя вводить ряд ограничений (фильтров) перед тем как показывать данные. Условия выборки указываются в опции WHERE оператора SELECT, что позволяет выбирать небольшие наборы данных и не нагружать сервер SQL.

Итог.

Перенос ваших приложений с BDE на dbExpress дает много преимуществ.

• более короткие транзакции

• больше контроля над сетевым трафиком и использованием ресурсов

• уменьшение размера программы и используемых ею ресурсов

• повышенная производительность

• легкое распространение приложения

• небольшой набор файлов для распространения

• кросс-платформенная разработка (Windows и Linux)

DbExpress минимизирует усилия по переносу приложений, т.к. он включает набор компонент, содержащих свойства и события, похожие на компоненты BDE настолько, насколько это возможно. Это позволяет вам перейти на качественную технологию работы с данными при минимуме изменения исходного кода ваших приложений.

Об авторе.

Bill Todd является президентом The Database Group, Inc, обеспечивающей консультации и разработку. Он является соавтором четырех книг по программированию на СУБД и более 90 статей, является членом TeamBorland, предоставляя техническое сопровождение в news-конференциях Borland. Представил более двух десятков документов на Borland Developer Conference. Bill также известен как преподаватель по Interbase и Delphi. Email - bill@dbinc.com.

Перевод осуществлен с разрешения Borland.

Впервые опубликовано на www.ibase.ru.

©Drkb::02688.

Архитектура BDE и его особенности при работе с SQL-серверами(статья).

Как работает BDE.

Или.

Архитектура BDE и его особенности при работе с SQL-серверами.

Кузьменко Дмитрий, www.ibase.ru. 25.08.2000 (исправления от 14.12.2000, 17.08.2001).

Этот материал основан на изучении документации и справочных материалов по BDE и на собственном опыте. На самом деле информация из этого документа частично появлялась и раньше как в FAQ Borland так и в материалах других авторов (в частности Epsylon Technologies). Однако до сих пор большое количество разработчиков используют BDE. Но в последнее время все больше людей работают с SQL-серверами, и более популярными становятся компоненты прямого доступа - IBObjects/FreeIBComponents/IBExpress, Direct Oracle Access и другие. Кроме того, BDE не поддерживается на Linux (в Kylix) и дальше развиваться не будет - The Future of the Borland Database Engine (BDE) and SQL Links (by John Kaster). В Delphi 6 наряду с BDE и в Kylix (Delphi и C++Builder для Linix) используется другая библиотека - dbExpress, которая и предлагается Borland в качестве замены BDE. Поэтому, чтобы поставить жирную точку (или крест, как хотите) на BDE, я и решил написать этот документ.

В большей степени этот текст напоминает то, что я читал на курсах по Delphi и разработке баз данных 3-4 года назад. Привет вам, курсанты! Можете прочитать этот документ хотя бы для того, чтобы освежить память.

Введение.

Для начала вернемся лет на 10 назад. В те времена на компьютерах властвовали настольные СУБД - dBase, Paradox, FoxPro, Clipper и т.п. SQL-сервера в основном работали на мэйнфреймах. Среди форматов настольных СУБД был полный разнобой, и например, хотя Clipper, FoxPro и dBase работали с форматом DBF, использовать таблицы друг друга они фактически не могли из-за мелких, но существенных различий. Обмениваться данными в те времена между разными СУБД можно было разве что при помощи импорта-экспорта. Многие компании понимали, что так дальше продолжаться не может. Некоторые встраивали в свои продукты несколько "движков", но это приводило к распуханию продукта, да и чаще всего пользователи работали только с одним форматом данных, а не несколькими одновременно.

В 1990-м году Borland приобрел компанию Ashton-Tate, а вместе с ней и dBase (и Interbase). Таким образом у Borland появилось две настольные СУБД, с совершенно разными форматами - dBase и Paradox. Понятно, что для дальнейшего развития этих продуктов усилия по развитию форматов данных и работы с ними фактически удваивались. И в частности поэтому было принято решение создать некое универсальное ядро доступа к данным, которое могло бы работать с несколькими форматами данных единым образом. Созданию такого ядра также способствовало появление Windows, а следовательно и разделяемых библиотек - DLL. Можно было выпускать несколько продуктов, используя одни и те же dll доступа к данным. Это вполне соответствовало объектно-ориентированной концепции разработки ПО, которая не только использовалась в Turbo Pascal и в Turbo C++, но и при разработке собственных приложений Borland, таких как dBase, Paradox и Quattro (все для Windows).

Примечание: дальнейшая информация по датам взята из документа, подзаголовок "Evolution of BDE/IDAPI Technology: 1990 - 94".

Технология была названа Open Database Application Programming Interface - ODAPI, и впервые была использована в Quattro Pro 1.0 for Windows в сентябре 1992 года. В январе 1993-го эта же версия ODAPI 1.0 была использована в Paradox 1.0 for Windows, а затем и в dBase 1.0 for Windows. ODAPI пока поддерживал только форматы dBase и Paradox, и мог выполнять запросы к обоим форматам при помощи механизма Query By Example (QBE), пришедшего из Paradox for DOS.

Справка: драйверы ODBC 1.0 от Microsoft впервые появились в августе 1993 года. Информация из MSDN.

Всего через полгода, в сентябре 1993, ODAPI 1.1 уже поддерживала работу с SQL-серверами Interbase, Oracle, Sybase и Microsoft.

Версия 2.0 была переименована в IDAPI (слово Open было заменено на Integrated), и работами по расширению и стандартизации этого интерфейса уже занимался не только Borland, а целый комитет с IBM, Novell и Wordperfect включительно. В этой версии появился Local SQL - ядро для выполнения запросов SQL к локальным форматам данных, и IDAPtor - механизм для подключения ODBC-драйверов к IDAPI.

Последняя 16-ти разрядная версия IDAPI 2.5 использовалась в Delphi 1. Далее, начиная с 3.0 (12 января 1996 года в составе Paradox 5.0 for Windows), пошли 32-разрядные версии. Собственно, на этом развитие функциональности BDE закончилось. Добавлялись новые драйверы для доступа к SQL-серверам DB2, Informix, в BDE 3.5 появились кэшированные обновления (CachedUpdates), появился драйвер FoxPro и сопряжение с DAO, но все это происходило на протяжении достаточно длительного срока - с 1996 по 2000.

С одной стороны, функциональность BDE можно назвать даже избыточной. С другой стороны повлияла конкуренция со стороны Microsoft, стандарта ODBC. Собственно, по функциональности ODBC является подмножеством BDE, но Microsoft в те годы предпринимала очень активные действия по продвижению ODBC, и главным в этом был выпуск ODBC SDK, с помощью которого любая фирма могла разработать собственный ODBC-драйвер (надо сказать, что в те годы их было огромное количество, причем большинство было весьма низкого качества и невысокой производительности). А BDE был более "закрытым". Например, BDE SDK так и не увидел свет, и был доступен разве что избранным (я оказался в их числе, и надо сказать, что качество BDE SDK и удобство написания драйверов было на высоте). С третьей стороны, к этому времени WordPerfect был куплен Novell, Paradox также был продан Novell, а затем Corel, а IBM похоже просто потеряла к IDAPI интерес.

Короче, комитет IDAPI распался, а Microsoft задавил конкуренцией.

Несмотря на перечисленные негативные моменты, BDE активно использовался не только самим Borland, но и многими другими фирмами. Это Novell (продукт InForms), ReportSmith (впоследствии купленный и проданный Borland), CrystalReports (вплоть до версии 5.0 использовал BDE) и так далее.

Архитектура.

Увлекшись историей я немного пропустил, зачем все это (BDE) делалось. Частичная цель упоминалась выше - предоставить универсальное ядро доступа к локальным форматам данных. Основная - обеспечить прозрачную работу приложений как с локальными форматами, так и с SQL-серверами. Как сейчас помню, что именно удобство при работе с SQL-серверами рекламировалось как основное. Однако в последние 2-3 года именно эта возможность вызывала наибольшее количество нареканий. Давайте рассмотрим архитектуру BDE.

Основная работа с BDE производится посредством внешнего интерфейса IDAPI (IDAPI32.DLL). Формат данных выбирается в псевдониме (alias) соединения, и в принципе дальше работа с разными форматами ничем не отличается. В том числе и неважно, как работает приложение с BDE - через компоненты VCL DB, которые используют функции BDE, или напрямую (все равно компоненты используют те же функции BDE).

Дальше функции IDAPI транслируют вызовы в функции соответствующего драйвера. Если это драйвер локального формата (dBase, Paradox, FoxPro), то драйвер формата сам работает с соответствующими файлами (таблицами и индексами). Если это SQL Link, то вызовы транслируются в вызовы функций API клиентской части конкретного SQL-сервера. Для каждого сервера SQL Link свой.

IDAPTOR (соединитель с ODBC) и интерфейс к DAO работает точно также как и SQL Link, т.е. просто транслирует вызовы BDE в вызовы ODBC или DAO, непосредственно к формату не имея никакого отношения.

Если посмотреть на файлы BDE, то можно подробно рассмотреть его составные части.

• IDAPI32.DLL - основной интерфейс

• BLW32.DLL, BANTAM.DLL- языковые функции

• *.BTL - файлы с языковыми кодировками.

• IDBAT32.DLL - операции пакетного копирования данных

• IDDR32.DLL - модуль работы с Data Repository

• IDASCI32.DLL - драйвер для работы с текстовым форматом

• IDDAO32.DLL - драйвер трансляции вызовов к DAO

• IDODBC32.DLL - драйвер трансляции вызовов к ODBC

• IDPDX32.DLL - драйвер для работы с форматом Paradox

• IDDBAS32.DLL - драйвер для работы с форматом dBase и FoxPro

• IDQBE32.DLL - ядро обработки запросов QBE

• IDSQL32.DLL - ядро обработки запросов SQL

• SQLINT32.DLL - SQLLink-драйвер трансляции вызовов к Interbase API

• SQLORA32.DLL - SQLLink-драйвер трансляции вызовов к Oracle Call Level Interface

• SQL*32.DLL - другие SQLLink-драйверы

Таким образом, при установке BDE "лишние" файлы можно без проблем выкинуть.

Также, надеюсь, понятно, почему BDE "не работает" с SQL-сервером, если не установлена клиентская часть этого сервера (то же самое по отношению к DAO - без дистрибутива DAO BDE не будет работать с файлами MS Access). Вообще клиентские части SQL-серверов несовместимы между собой абсолютно. Поэтому невозможно написать универсальный SQL Link.

Данный рисунок и список файлов, возможно, развеет популярный миф о том, что Delphi хорошо приспособлена для работы с Interbase. Как видите, Interbase для Delphi столь же равноправен, как скажем, Oracle или любой ODBC-драйвер. В отличие от продуктов Microsoft в BDE нет никаких "обходных" функций для работы со своими форматами, т.е. работа с IB ведется только через SQL Link (без sqlint32.dll BDE вообще не знает, что такое Interbase).

Отдельное место в архитектуре BDE и среди упомянутых файлов занимают Local SQL и QBE Engine. Эти механизмы запросов будут рассмотрены чуть дальше.

TTable и TQuery.

TTable и TQuery являются основными компонентами, используемыми при программировании приложений баз данных (TStoredProc не в счет, и без него можно прекрасно обойтись, вызывая процедуры через select или execute в компоненте TQuery). TTable предоставляет доступ как к таблицам, а TQuery позволяет выполнять произвольные запросы. Если с TQuery все понятно - он выполняет тот запрос, который написан в свойстве TQuery.SQL - то TTable скрывает очень много подробностей своей работы от программиста. Без SQL Monitor увидеть все тонкости невозможно (если кто не знает - SQL Monitor находится в меню Database).

Итак, запустите Delphi, откройте SQL Monitor, положите на форму компонент TDatabase, подсоединитесь к серверу, затем положите компонент TTable, присоедините его к алиасу TDatabase и выберите любую таблицу из списка (свойство TableName). Переключитесь на SQL Monitor, сотрите все что там появилось, переключитесь обратно, и включите TTable.Active:=True; Смотрим в SQL Monitor (лог с самого начала):

• первым запросом BDE хочет убедиться, что выбранная нами таблица существует.

• второй запрос выбирает список полей выбранной таблицы, их названий, типов, условий проверки и т.п.

• третий запрос выбирает информацию об индексах указанной таблицы. Определяется, есть ли среди них первичный ключ, и по каким полям построены индексы.

• четвертый запрос почти повторяет второй, и выбирает информацию о полях - условия проверки, "вычисляемость" поля, допустимость NULL и прочее.

• собственно, пятый запрос открывает таблицу, формируя запрос SELECT FIELD1, FIELD2, ... FROM TABLE ORDER BY PK_FIELD ASC.

Заметьте, что подобные запросы выполняются каждый раз при открытии таблицы (любой) компонентом TTable. Перечитывания этих данных можно избежать, если включить у используемого алиаса параметр ENABLE SCHEMA CACHE. При этом считанную первый раз информацию BDE размещает на диске в указанном каталоге (SCHEMA CACHE DIR) в специальном файле, кэширует информацию для SCHEMA CACHE SIZE количества таблиц, и держит эту информацию в кэше в течение SCHEMA CACHE TIME секунд (если -1, то вечно). Если структуры таблиц закэшированы, то при их изменении на сервере (например, добавили новое поле) приложение будет работать со старой структурой, что может вызвать серьезные проблемы в работе приложения. SCHEMA CACHE нужно использовать только тогда, когда структура базы данных определена окончательно и не изменяется. Если все же очень сильно хочется использовать кэширование структур таблиц, то не забывайте правильно установить параметр SCHEMA CACHE TIME. Или при первом за день подключении приложения к серверу сначала кэширование структур можно выключить, отсоединиться, включить и подсоединиться снова - таким образом в самом начале работы кэш структур таблиц будет создан, и будет использоваться в течение дня.

Примечание: параметры SCHEMA CACHE не имеют абсолютно никакого отношения к механизму Cached Updates или к кэшированию данных.

Вернемся к запросу, которым TTable открыл таблицу. В конце запроса стоит указание порядка сортирвки - ORDER BY FIELD ASC. По умолчанию TTable сортирует данные в порядке поля первичного ключа. И кстати, если пользоваться свойством TTable.IndexName, то все равно к запросу будет добавляться ORDER BY INDEXFIELD ASC. Таким образом получается, что свойство IndexName при работе с SQL-серверами бессмыслено. Вместо него нужно просто использовать свойство IndexFieldNames. Даже если в этом свойстве указать поле, по которому нет индекса, то все равно BDE "прицепит" к запросу ORDER BY FIELD ASC. Кстати, BDE абсолютно игнорирует направление индекса, и всегда в запросе добавляет ASC, даже если индекс по этому полю создан как DESCENDING (по убыванию). Получается, что отсортировать таблицу в TTable по убыванию нельзя.

Примечание: можно было бы отнести этот недостаток на SQL Link для IB, но вполне возможно что просто TTable не в состоянии кэшировать и обновлять данные, отсортированные по убыванию (см. дальше о кэше данных).

Кэширование данных.

Как видно из предыдущего раздела, TTable работает с таблицами сервера не каким-то хитрым образом, а формируя самые нормальные SQL-запросы. И тут начинается самое интересное. Оказывается, при выполнении запроса сервер выдает записи клиенту (приложению) по очереди и по одной записи. Причем только "сверху вниз". Как только записи на сервере кончились, сервер сообщает клиенту об этом сигналом EOF вместо выдачи очередной записи. Конечно, в некоторых современных серверах есть произвольное позиционирование и проход по выборке не только сверху вниз но и в обратном порядке, но это требует от сервера достаточно больших ресурсов.

Примечание: разумеется, клиентская часть SQL-сервера может принимать записи от сервера "пачками". Но в любом случае получение записи инициируется только вызовом функции fetch, и по этой команде "выбирается" только одна запись. Т.е. приложение получает записи по одной независимо от того, буферизируются они на сервере/клиенте или нет.

Поскольку BDE - вещь универсальная, то он должен обеспечить возможность перемещения по записям вверх и вниз независимо от сервера. Т.е. он должен обеспечивать кэширование записей самостоятельно. Взял запись с сервера - положил в кэш. Это означает, что если вы открыли таблицу в 100 тысяч записей, и нажали в гриде Ctrl-End, то все 100 тысяч записей "приедут" к вам на клиентский компьютер. С таким пожиранием ресурсов надо как то бороться. Если в TQuery можно ограничить количество выбираемых записей условиями запроса, то в TTable этого сделать нельзя, поскольку как мы уже видели, TTable формирует запросы самостоятельно.

Живой и мертвый кэш, или TTable и TQuery.

Для решения проблем кэширования TTable было введено два разных механизма кэширования. Для TTable - "живой" кэш, а для TQuery - "мертвый". Для простоты лучше сначала рассмотреть "мертвый" кэш. Вообще тут и рассматривать нечего - при перемещении по записям записи помещаются в кэш. Как только все записи помещены (пользователь "доехал" до конца выборки каким-либо способом), обращения к серверу прекращаются, и любые передвижения пользователя по записям совершаются только в кэше.

У "мертвого" кэша есть побочный эффект - если вызвать метод Locate для поиска записи, то TQuery принудительно выберет все записи в кэш, и только потом будет искать нужную запись в кэше. Собственно, пока запись не считана, неизвестно - попадает она под условие Locate или нет. Поэтому другим способом здесь искать записи невозможно.

"Мертвый" кэш существует до тех пор, пока запрос не будет закрыт (TQuery.Close).

Живой кэш более сложен, и для его понимания придется использовать чуть больше компонент на уже открытой в Delphi форме. Добавьте к TDatabase и TTable компоненты TDataSource и TDBGrid. Grid растяните по вертикали так, чтобы в нем было видно штук 5 записей (7, или 9, не больше). Желательно чтобы в таблице при этом было не меньше 20-30 записей. Поместите кнопку рядом с Grid-ом, в которой на OnClick напишите.

Table1.IndexFieldNames:='FIELD';

Где FIELD - любое имя поля открытой таблицы, главное чтобы не поле первичного ключа. Наличие индекса по этому полю не обязательно.

Скомпилируйте приложение, запустите его (не забыв запустить SQL Monitor). Поместите курсор грида посередине, как показано на рисунке (на содержимое грида не обращайте внимания - у вас оно будет совершенно другим, в зависимости от выбранной таблицы).

Сотрите все в SQL Monitor. И нажмите кнопку Button1. Теперь возвращаемся к началу лога в SQL Monitor:

• первый запрос выбирает значение поля, по которому нужно отсортировать данные.

• второй запрос выбирает данные от текущей записи и "выше" - см добавку WHERE FIELD < ? ORDER BY FIELD DESC

• третий запрос выбирает запись, которую нужно поместить на место текущей (выборка запомненного первым запросом значения). Кстати, этот запрос у меня почему-то выполнился аж три раза (BDE 5.1.1). Раньше он обычно выполнялся всего один раз.

• четвертый запрос выбирает данные от текущей записи и ниже - см. добавку WHERE FIELD > ? ORDER BY FIELD ASC

Вот это и есть "живой" кэш. Т.е. при любых операциях перемещения по набору данных, отличных от перемещения на одну запись (или PageUp/PageDown) вверх или вниз, TTable уничтожает текущий кэш, перечитывает данные столь экзотическим образом, и создает новую копию кэша. По количеству вызовов isc_dsql_fetch вы можете понять, что как "вверх" так и "вниз" от текущей записи второй и четвертый запросы выбрали ровно столько записей, сколько помещается в Grid. Если вы продолжите движение курсором по одной строке вверх или вниз, то увидите каким способом (зачастую неэффективным) BDE довыбирает необходимые записи (особенно неэффективность проявляется при движении вверх).

Если же курсор находится вверху или внизу грида, то вместо трех запросов отображения данных будет два - выборка текущей записи и выборка записей только вверх или вниз от текущей записи.

Существенный момент - выборка "вверх" всегда использует сортировку по убыванию. Если по полю сортировки нет индекса по убыванию, то Interbase (или другой сервер) будет сортировать результат в памяти или на диске, что существенно медленнее сортировки с использованием индекса. Поэтому "резкие" перемещения, например в конец таблицы при помощи Ctrl-End будут приводить к значительной паузе, пока сервер отсортирует данные и выдаст результат. Повысить скорость в этом случае можно только использованием ClientDataSet, который сортирует кэш вместо выдачи серверу SQL-запросов.

Locate в живом кэше в отличие от мертвого кэша выполняется намного быстрее, т.к. TTable применяет ту же самую технику очистки кэша для поиска нужной записи.

Фильтрация.

Фильтрация TTable и TQuery происходит с учетом живого или мертвого кэша. Для TTable при наложении фильтра конструируется соответствующий SQL-запрос, а TQuery производит фильтрацию буквально при помощи Locate (т.е. сначала выбираются все записи в кэш, а затем идет фильтрация уже в кэше).

О вреде UNIQUE constraint.

В Interbase уникальность поля можно обеспечить тремя способами: создать первичный ключ, создать unique constraint, и создать уникальный индекс. Но при чем здесь Interbase? А при том, что BDE открывает TTable по умолчанию с использованием уникального индекса. Если таблица одновременно содержит как первичный ключ, так и unique constraint, то в результате у таблицы 2 уникальных индекса. При обращении к списку индексов TTable берет для сортировки по умолчанию первый попавшийся. Если уникальность поля обеспечивается обычным уникальным индексом, то проблем нет. А вот если та же уникальность обеспечивается через UNIQUE constraint, то при backup/restore базы данных есть шанс что порядковые номера индексов поменяются (поскольку для IB это constraint целостности), и BDE будет брать в качестве первого попавшегося индекс от unique constraint вместо индекса от primary key. Вреда от этого, в общем, никакого нет, но в результате это вызывает нежелательный порядок сортировки по умолчанию в приложениях.

"Живые" запросы.

Если способность TTable редактировать и удалять записи ни у кого не вызывает удивления, то TQuery требует, чтобы свойство RequestLive было установлено в True. Если при False запрос отправлялся непосредственно на сервер, то при True запрос предварительно обрабатывается локальным SQL (модуль IDSQL32.DLL). Это необходимо для того, чтобы TQuery смог сформировать запросы INSERT/UPDATE/DELETE на основании заданного SELECT. Для TTable построение таких запросов не представляет сложности, т.к. задано только имя таблицы, имена полей считаны и т.п. А существующий SQL-запрос нужно синтаксически разобрать, чтобы понять, сколько в нем используется таблиц, какие выбираются поля и из каких таблиц, и можно ли вообще сформировать запросы на вставку, обновление и удаление данных.

Именно таким разбором SQL и занимается Local SQL. Разумеется, он поддерживает весьма ограниченный синтаксис SQL, что не позволяет делать "живыми" запросы, использующие расширенные конструкции SQL, пользовательские функции или специфические для конкретного сервера особенности. Например, для организации живого запроса вместо.

Code: SELECT * FROM TABLE. WHERE FIELD STARTING WITH 'A'

Многострочные подсказки.

Если подсказка длинная, то удобно ее разместить в две или более строк.

Code: Procedure TForm1.FormCreate(Sender: TObject); Begin. Button1.Hint := 'Only one string'; Button2.Hint := 'There will be' + #13#10 + 'two strings'; Form1.ShowHint := true; End;

Как засечь время.

Засекание обычно нужно в двух случаях: самому программисту – узнать, как программа работает быстрее, или для информирования пользователя, сколько программа уже трудится.

Вычисление даты Пасхи.

Автор: Mark Lussier.

Как вывести диалог Обзор папок.

Для вывода диалога "Обзор папок" существует функция SHBrowseForFolder. Для выбора того, какие папки будут выведены в диалоге, используется функция SHGetSpecialFolderLocation. В этой программе выводится рабочий стол со всеми подпапками (папки рабочего стола, Мой компьютер, Корзина). Для выбора папки в меню пуск используется CSIDL_STARTMENU вместо CSIDL_DESKTOP.

Code: Uses ShlObj; Procedure CallBack(wnd: hWnd; uMsg: UINT; lParam, lpData: LParam) stdcall; Begin. SendMessage(wnd, BFFM_ENABLEOK, 0, 1); End; Procedure TForm1.Button1Click(Sender: TObject); Var. Bi: TBrowseInfo; S: PChar; PIDL, ResPIDL: PItemIDList; Begin. SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, PIDL); S := StrAlloc(128); Bi.hwndOwner := Form1.Handle; Bi.pszDisplayName := s; Bi.lpszTitle := 'Выбор прапки'; Bi.pidlRoot := PIDL; Bi.lpfn := addr(CallBack); ResPidl := SHBrowseForFolder(BI); SHGetPathFromIDList(ResPidl, s); Form1.Caption := s; End;

Распознавание кодировки.

Алгоритм распознавания кодировки нужен для автоматического декодирования текста. Этот алгоритм основан на том, что некоторые буквы русского алфавита встречается очень часто, а некоторые редко. Поскольку этот способ статистический, то лучше всего он работает с большими текстами.

Code: Type. TCode = (win, koi, iso, dos); Const. CodeStrings: array [TCode] of String = ('win','koi','iso','dos'); Procedure TForm1.Button1Click(Sender: TObject); Var. Str: array [TCode] of string; Norm: array ['А'..'я'] of single; Code1, code2: TCode; Min1, min2: TCode; Count: array [char] of integer; D, min: single; S, so: string; Chars: array [char] of char; C: char; I: integer; Begin. So := Memo1.Text; Norm['А'] := 0.001; Norm['Б'] := 0; Norm['В'] := 0.002; Norm['Г'] := 0; Norm['Д'] := 0.001; Norm['Е'] := 0.001; Norm['Ж'] := 0; Norm['З'] := 0; Norm['И'] := 0.001; Norm['Й'] := 0; Norm['К'] := 0.001; Norm['Л'] := 0; Norm['М'] := 0.001; Norm['Н'] := 0.001; Norm['О'] := 0.001; Norm['П'] := 0.002; Norm['Р'] := 0.002; Norm['С'] := 0.001; Norm['Т'] := 0.001; Norm['У'] := 0; Norm['Ф'] := 0; Norm['Х'] := 0; Norm['Ц'] := 0; Norm['Ч'] := 0.001; Norm['Ш'] := 0.001; Norm['Щ'] := 0; Norm['Ъ'] := 0; Norm['Ы'] := 0; Norm['Ь'] := 0; Norm['Э'] := 0.001; Norm['Ю'] := 0; Norm['Я'] := 0; Norm['а'] := 0.057; Norm['б'] := 0.01; Norm['в'] := 0.031; Norm['г'] := 0.011; Norm['д'] := 0.021; Norm['е'] := 0.067; Norm['ж'] := 0.007; Norm['з'] := 0.013; Norm['и'] := 0.052; Norm['й'] := 0.011; Norm['к'] := 0.023; Norm['л'] := 0.03; Norm['м'] := 0.024; Norm['н'] := 0.043; Norm['о'] := 0.075; Norm['п'] := 0.026; Norm['р'] := 0.038; Norm['с'] := 0.034; Norm['т'] := 0.046; Norm['у'] := 0.016; Norm['ф'] := 0.001; Norm['х'] := 0.006; Norm['ц'] := 0.002; Norm['ч'] := 0.011; Norm['ш'] := 0.004; Norm['щ'] := 0.004; Norm['ъ'] := 0; Norm['ы'] := 0.012; Norm['ь'] := 0.012; Norm['э'] := 0.003; Norm['ю'] := 0.005; Norm['я'] := 0.015; Str[win] := 'АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя'; Str[koi] := 'юЮаАбБцЦдДеЕфФгГхХиИйЙкКлЛмМнНоОпПяЯрРсСтТуУжЖвВьЬыЫзЗшШэЭщЩчЧъЪ'; Str[iso] := 'РрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяа№бёвђгѓдєеѕжізїијйљкњлћмќн§оўпџ'; Str[dos] := 'Ђ ЃЎ‚ўѓЈ„¤…Ґ†¦‡§ЂЁ‰©ЉЄ‹"Њ¬ЌЋ®ЏЇђа'б'в"г"д•е–ж—з и™йљк›лњмќнћоџп'; For c := #0 to #255 do. Chars[c] := c; Min1 := win; Min2 := win; Min := 0; S := so; Fillchar(count, sizeof(count), 0); For i := 1 to Length(s) do. Inc(count[s[i]]); For c := 'А' to 'я' do. Min := min + sqr(count[c] / Length(s) - norm[c]); For code1 := low(TCode) to high(TCode) do begin. For code2 := low(TCode) to high(TCode) do begin. If code1 = code2 then continue; S := so; For i := 1 to Length(Str[win]) do. Chars[Str[code2][i]] := Str[code1][i]; For i := 1 to Length(s) do. S[i] := Chars[s[i]]; Fillchar(count, sizeof(count), 0); For i := 1 to Length(s) do. Inc(count[s[i]]); D := 0; For c := 'А' to 'я' do. D := d + sqr(count[c] / Length(s) - norm[c]); If d < min then begin. Min1 := code1; Min2 := code2; Min := d; End; End; End; S := Memo1.Text; If min1 <> min2 then begin. For c := #0 to #255 do. Chars[c] := c; For i := 1 to Length(Str[win]) do. Chars[Str[min2][i]] := Str[min1][i]; For i := 1 to Length(s) do. S[i] := Chars[s[i]]; End; Form1.Caption := CodeStrings[min2] + ' ' + CodeStrings[min1]; Memo2.Text := s; End;

Как сравнить быстродействие алгоритмов.

Если вас сколько-нибудь интересует скорость работы вашей программы, то нужно смерить скорость алгоритмов и сравнивать их. Здесь я привожу пример, сравнивающий четыре способа возведения 2 в степень 30.

Code: Uses Math; Procedure TForm1.Button1Click(Sender: TObject); Var. Res, Exponent: integer; Res1: real; T, i: integer; Begin. Exponent := 30; Application.ProcessMessages; T := GetTickCount; For i := 1 to 1000000 do. Res := 1 shl Exponent; Form1.Caption := Form1.Caption + ' ' + IntToStr(GetTickCount - t); Application.ProcessMessages; T := GetTickCount; For i := 1 to 1000000 do. Res1 := LdExp(1, Exponent); Form1.Caption := Form1.Caption + ' ' + IntToStr(GetTickCount - t); Application.ProcessMessages; T := GetTickCount; For i := 1 to 1000000 do. Res1 := IntPower(2, Exponent); Form1.Caption := Form1.Caption + ' ' + IntToStr(GetTickCount - t); Application.ProcessMessages; T := GetTickCount; For i := 1 to 1000000 do. Res1 := Power(2, Exponent); Form1.Caption := Form1.Caption + ' ' + IntToStr(GetTickCount - t); End;

Как добавить файл в меню Пуск/Документы.

Эта программа добавляет файл "File.txt" в "Пуск/Документы".

Code: Uses ShlOBJ; Procedure TForm1.Button1Click(Sender: TObject); Begin. SHAddToRecentDocs(SHARD_PATH, PChar('File.txt')); End;

Как выдавить текст.

Чтобы сделать текст выпуклым, нужно за светло-серой надписью разместить точно такие же надписи, только белую чуть левее и выше и светло-серую чуть правее и ниже.

Приведенная ниже программа выводит выпуклый текст, который вдавливается при нажатии.

Code: Const. S = 'It is a text string'; ColDark = clGray; ColNorm = clSilver; ColLight = clWhite; XPos = 10; YPos = 10; Dx = 1; Dy = 1; Procedure TForm1.FormCreate(Sender: TObject); Begin. Form1.Canvas.Brush.Style := bsClear; With Form1.Canvas.Font do begin. Name := 'Arial'; Size := 20; Style := [fsBold]; End; End; Procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. With Form1.Canvas do begin. Font.Color := ColDark; TextOut(XPos - dx, YPos - dy, s); Font.Color := ColLight; TextOut(XPos + dx, YPos + dy, s); Font.Color := ColNorm; TextOut(XPos, YPos, s); End; End; Procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. With Form1.Canvas do begin. Font.Color := ColLight; TextOut(XPos - dx, YPos - dy, s); Font.Color := ColDark; TextOut(XPos + dx, YPos + dy, s); Font.Color := ColNorm; TextOut(XPos, YPos, s); End; End; Procedure TForm1.FormPaint(Sender: TObject); Begin. Form1.MouseUp(mbLeft, [], 0, 0); End;

Как вывести полупрозрачный текст.

Пример вывода полупрозрачного текста.

Code: Procedure TForm1.FormPaint(Sender: TObject); Var. X, y: integer; Bm: TBitMap; Begin. Form1.ClientWidth := 200; Form1.ClientHeight := 100; Randomize; For x := 0 to 199 do. For y := 0 to 99 do. If random(3) = 1. Then Form1.Canvas.Pixels[x,y] := clGreen. Else Form1.Canvas.Pixels[x,y] := clLime; Bm := TBitMap.Create; Bm.Width := 200; Bm.Height := 100; With bm.Canvas do begin. Brush.Color := clGreen; FillRect(ClipRect); Font.Name := 'Arial'; Font.Size := 50; Font.Color := clGray; Font.Style := [fsBold]; TextOut((bm.Width - TextWidth('Text')) div 2, (bm.Height - TextHeight('Text')) div 2, 'Text'); End; Form1.Canvas.CopyMode := cmSrcPaint; Form1.Canvas.CopyRect(bm.Canvas.ClipRect, bm.Canvas, Bm.Canvas.ClipRect); Bm.Destroy; End;

Как выводить hint при движении мыши над списком.

В Windows, в частности в Delphi, используются Hint для полного отображения не умещающихся строк. Достаточно к такой строке поднести мышь, и всплывает подсказка с полным текстом на том же месте. Как это реализовать показано ниже.

Code: ... Public. HintRow: Integer; HintString: String; Procedure OnShowHint(var HintStr: string; Var CanShow: Boolean; var HintInfo: THintInfo); ... Procedure TForm1.FormCreate(Sender: TObject); Begin. Application.HintPause := 100; Application.HintHidePause := 30000; ListBox1.Items.Add('It is a long row'); ListBox1.Items.Add('It is a very long row'); ListBox1.Items.Add('And it is a very very long row'); ListBox1.Items.Add('But this row if longer then other rows'); ListBox1.Items.Add('It was not truth, because this row is so long, that I do not know, what' + #13#10 + 'will do the program with this row. Do You know it? I think that it will be' + #13#10 + 'very interesting to look at this row. But if it will be longer and longer,' + #13#10 + 'what will be? Look!!!'); ListBox1.Items.Add('Short row'); ListBox1.Items.Add('123'); HintRow := -1; Application.OnShowHint := OnShowHint; ListBox1.ShowHint := true; End; Procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Var. ItemNum: Integer; Begin. ItemNum := ListBox1.ItemAtPos(Point(X, Y), True); If (ItemNum <> HintRow) then begin. HintRow := ItemNum; Application.CancelHint; If HintRow > -1 then begin. HintString := ListBox1.Items[ItemNum]; If (ListBox1.Canvas.TextWidth(HintString) <= ListBox1.ClientWidth). Then HintString := ''; End else HintString := ''; End; End; Procedure TForm1.OnShowHint(var HintStr: string; Var CanShow: Boolean; var HintInfo: THintInfo); Begin. If not (HintInfo.HintControl is TListBox) then Exit; With HintInfo.HintControl as TListBox do begin. HintInfo.HintPos := ListBox1.ClientToScreen(Point(-1, ListBox1.ItemRect(HintRow).Top - 3)); HintStr := HintString; End; End;

Как выводить элементы списка разными шрифтами.

Очень удобно выбирать шрифты, когда в списке каждый шрифт написан собой. Например, "Arial" будет написано шрифтом Arial, а "Times" - Times. Список шрифтов лежит в свойстве Fonts объекта Screen.

Code: Procedure TForm1.FormCreate(Sender: TObject); Begin. ListBox1.Items := Screen.Fonts; ListBox1.Style := lbOwnerDrawVariable; End; // Определение высоты элемента списка. Procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; Var Height: Integer); Begin. With ListBox1.Canvas do begin. Font.Name := ListBox1.Items.Strings[index]; Font.Size := 0; // Размер шрифта – по умолчанию. Height := TextHeight(ListBox1.Items.Strings[index]) + 2; End; End; // Вывод названия шрифта. Procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); Begin. With ListBox1.Canvas do begin. Font.Name := ListBox1.Items.Strings[index]; Font.Size := 0; // Размер шрифта – по умолчанию. TextOut(Rect.Left + 1, Rect.Top + 1, ListBox1.Items.Strings[index]); End; End;

Выравнивание текста по ширине.

Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину.

Здесь создана процедура GetLine, которая возвращает одну строку, начиная с заданного символа. Программа находит разницу между шириной текста и реальной длинной строки и при выводе компенсирует эту разницу удлинением пробелов.

Эта программа выводит на экран текст из файла C:\text.txt, выравнивая его по двум краям.

Code: Type. ... TLine = record. S: string; Wrap: boolean; Length: integer; End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Const. FileName = 'C:\text.txt'; Var. S: string; Bm: TBitMap; LineH: integer; MaxTextWidth: integer; Procedure TForm1.FormCreate(Sender: TObject); Var. F: TFileStream; Buf: array [0..127] of char; L: integer; Begin. ScrollBar1.Kind := sbVertical; Bm := TBitMap.Create; With bm.Canvas.Font do begin. Name := 'Serif'; Size := 12; End; LineH := bm.Canvas.TextHeight('123'); If not FileExists(FileName) then begin. ShowMessage('Can not find file ' + FileName); Exit; End; F := TFileStream.Create(FileName, fmOpenRead); Repeat. L := F.Read(buf, 128); If l = 128. Then s := s + buf. Else s := s + copy(buf, 1, l); Until l < 128; F.Destroy; End; Procedure TForm1.FormResize(Sender: TObject); Begin. PaintBox1.Left := 0; PaintBox1.Top := 0; PaintBox1.Height := Form1.ClientHeight; PaintBox1.Width := Form1.ClientWidth - ScrollBar1.Width; ScrollBar1.Left := PaintBox1.Width; ScrollBar1.Top := 0; ScrollBar1.Height := PaintBox1.Height; Bm.Width := PaintBox1.Width; Bm.Height := PaintBox1.Height; ScrollBar1.Max := 1000; MaxTextWidth := PaintBox1.Width - 20; End; Function RealTextWidth(s: string): integer; Var. I: integer; Begin. Result := bm.Canvas.TextWidth(s); For i := 1 to Length(s) do. If s[i] = #9 then. Inc(result, 40 - bm.Canvas.TextWidth(#9)); End; Function GetLine(index: integer): TLine; Var. I: integer; S1: string; First: integer; Begin. If (s[index] = #13) and (s[index + 1] = #10) then begin. Result.s := ''; Result.length := 2; Result.wrap := true; Exit; End; First := index; While (first <= Length(s)) and (s[first] in [#32]) do inc(first); I := first; Repeat. While (i <= Length(s)) and (not (s[i] in [#9, #32])) and (s[i] <> #13) do. Inc(i); S1 := copy(s, first, i - index); Inc(i); Until (i >= Length(s)) or (s[i-1] = #13) or (RealTextWidth(s1) > MaxTextWidth); If RealTextWidth(s1) > MaxTextWidth then begin. Result.wrap := false; If i < Length(s) then begin. Dec(i, 2); While (i > 0) and (not (s[i] in [#9, #32])) do dec(i); Result.Length := i - index; While (i > 0) and (s[i] in [#9, #32]) do dec(i); End; Result.s := copy(s, first, i - index + 1); If result.s[length(result.s)] = #32 then. Delete(result.s, length(result.s) , 1); End else begin. Result.length := i - index + 1; S1 := copy(s, first, i - index + 1); If length(s1) > 0 then begin. If s1[Length(s1)] = #9. Then delete(s1, Length(s1), 1); If s1[length(s1) - 1] + s1[length(s1)] = #13#10. Then delete(s1, length(s1) - 1, 2); End; Result.s := s1; Result.wrap := true; End; End; Procedure draw; Var. I, j: integer; Line: TLine; OneWord: string; LineN: integer; SpaceCount: integer; TextLeft: integer; Shift, allshift: integer; D: integer; LineCount: integer; Begin. With bm.Canvas do begin. FillRect(ClipRect); I := 1; LineCount := 0; For j := 1 to Form1.ScrollBar1.Position do begin. Line := GetLine(i); Inc(i, line.length); Inc(LineCount); End; LineN := 0; Repeat. Line := GetLine(i); SpaceCount := 0; TextLeft := 0; For j := 1 to Length(line.s) do. If line.s[j] = #32 then inc(SpaceCount); If line.wrap = false. Then allshift := MaxTextWidth - RealTextWidth(line.s). Else allshift := 0; If allshift > 40 * SpaceCount then allshift := 0; Shift := 0; For j := 1 to Length(line.s) do begin. If (not (line.s[j] in [#9, #32])) and (j < Length(line.s)) then begin. OneWord := OneWord + line.s[j]; End else begin. OneWord := OneWord + line.s[j]; If OneWord = #9 then begin. Inc(TextLeft, 40); End else begin. If OneWord = #13#10 then begin. Inc(LineN); End else begin. TextOut(10 + TextLeft, LineN * LineH, OneWord); If SpaceCount = 0. Then d := 0. Else d := (allshift - shift) div (SpaceCount); Inc(shift, d); Inc(TextLeft, TextWidth(OneWord) + d); Dec(SpaceCount); End; End; OneWord := ''; End; End; Inc(i, line.length); Inc(LineN); Until (LineN * LineH > Form1.PaintBox1.Height) or (i >= Length(s)); Repeat. Line := GetLine(i); Inc(i, line.length); Inc(LineCount); Until i >= Length(s); Inc(LineCount, LineN); Form1.ScrollBar1.Max := LineCount - Form1.PaintBox1.Height div LineH; End; Form1.PaintBox1.Canvas.Draw(0, 0, bm); End; Procedure TForm1.PaintBox1Paint(Sender: TObject); Begin. Draw; End; Procedure TForm1.ScrollBar1Change(Sender: TObject); Begin. Draw; End;

Как различать звуковые CD.

Лазерный диск имеет свой идентификатор. Если сохранить, какому диску соответствует какой идентификатор, то можно реализовать определение диска.

В этой программе при нажатии на кнопку происходит проверка, есть ли название этого диска в файле. Если есть, то в заголовок окна выводится его название, если нет, то введенное пользователем название диска сохраняется в файл.

Code: 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;

©Drkb::01406.

Автор советов: Даниил Карапетян.

E-mail: delphi4all@narod.ru.

Автор справки: Алексей Денисов.

E-mail: aleksey@sch103.krasnoyarsk.su.

Сыграть звуковой файл без компонентов.

Если Вам не нужен компонент MediaPlayer, а сыграть звук, например, при нажатии на кнопку, нужно, воспользуйтесь функцией PlaySound. Одна из ее возможностей – сыграть wav-файл.

Code: Uses MMsystem; Procedure TForm1.Button1Click(Sender: TObject); Begin. If OpenDialog1.Execute then. PlaySound(PChar(OpenDialog1.FileName), 0, SND_FILENAME); End;

Реализовать фоновую работу программы.

Попробуйте запустить программу. Пока компьютер ничего не делает, рисунок на окне все время меняется, но, стоит загрузить компьютер какой-либо работой, и изменение фона прекращается. В этой программе можно подвигать мышью по окну – это приведет к сравнительно сложным действиям, поэтому фоновая работа программы временно прекратится.

Code: ... Public. Row: integer; Procedure OnIdleProc(Sender: TObject; var Done: Boolean); ... Procedure TForm1.FormCreate(Sender: TObject); Begin. Application.OnIdle := OnIdleProc; End; Procedure TForm1.OnIdleProc(Sender: TObject; var Done: Boolean); Var. I: integer; Col: TColor; Gray: integer; Begin. For i := 0 to Form1.ClientWidth - 1 do begin. Col := Form1.Canvas.Pixels[i, Row]; Gray := GetRValue(col) + round(30 * sin(i / 30 + Row / 50)); Form1.Canvas.Pixels[i, Row] := RGB(Gray, Gray, Gray); End; Inc(Row); If (Row = Form1.ClientHeight) then Row := 0; Done := false; End; Procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Var. I: integer; Begin. With Form1.Canvas do begin. Brush.Style := bsClear; For i := 0 to 1000 do begin. Pen.Color := RGB(i, i, i); Rectangle(X - i, Y - i, X + i, Y + i); End; End; End;

©Drkb::04572.

Размыть изображение.

В этом способе цвету каждой точки присваивается среднее значение цветов соседних точек.

Code: Procedure TForm1.Button1Click(Sender: TObject); Const. Width = 100; Height = 60; D = 2; Var. X, y: integer; I, j: integer; C: integer; Pix: array [0..width-1, 0..height-1] of byte; Begin. Randomize; With Form1.Canvas do begin. Font.Name := 'Arial'; Font.Size := 30; TextOut(d, d, 'Text'); For y := 0 to height - 1 do. For x := 0 to width - 1 do. Pix[x,y] := GetRValue(Pixels[x,y]); For y := d to height - d - 1 do begin. For x := d to width - d - 1 do begin. C := 0; For i := -d to d do. For j := -d to d do. C := c + Pix[x+i,y+j]; C := round(c / sqr(2 * d + 1)); Pixels[x,y] := RGB(c, c, c); End; Application.ProcessMessages; End; End; End;

Определить размера рабочей области Dеsкtор'а.

Иногда важно знать, какую часть экрана можно занимать, не перекрывая тем самым такие окна, как TaskBar. Эта программа разворачивает окно на всю рабочую область Dеsкtор'а.

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. R : TRect; Begin. SystemParametersInfo(SPI_GETWORKAREA, 0, Addr(r), 0); Form1.Left := r.Left; Form1.Top := r.Top; Form1.Width := r.Right - r.Left; Form1.Height := r.Bottom - r.Top; End;

Открыть файл JPEG.

В комплект поставки Delphi входит модуль JPEG. Он позволяет работать с изображениями в формате JPEG. Эта программа открывает выбранный файл и выводит изображение на форму.

Code: Uses Jpeg; Procedure TForm1.Button1Click(Sender: TObject); Var. JpegIm: TJpegImage; Bm: TBitMap; Begin. If OpenDialog1.Execute = false then Exit; Bm := TBitMap.Create; JpegIm := TJpegImage.Create; JpegIm.LoadFromFile(OpenDialog1.FileName); Bm.Assign(JpegIm); Form1.Canvas.Draw(0, 0, bm); Bm.Destroy; JpegIm.Destroy; End;

Сохранить изображение в формате JPEG.

В комплект поставки Delphi входит модуль JPEG. Он позволяет работать с изображениями в формате JPEG. Эта программа сохраняет изображение экрана в файле C:\Screen.jpg.

Code: Uses Jpeg; Procedure TForm1.Button1Click(Sender: TObject); Var. JpegIm: TJpegImage; Bm: TBitMap; Begin. Bm := TBitMap.Create; Bm.Width := Screen.Width; Bm.Height := Screen.Height; BitBlt(bm.Canvas.Handle, 0, 0, Bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY); JpegIm := TJpegImage.Create; JpegIm.Assign(bm); JpegIm.CompressionQuality := 20; JpegIm.Compress; JpegIm.SaveToFile('C:\Screen.jpg'); Bm.Destroy; JpegIm.Destroy; End;

Имитировать события мыши.

В этом примере курсор мыши сам встает на кнопку и нажимает на нее.

Code: Procedure TForm1.Timer1Timer(Sender: TObject); Var. P: TPoint; Begin. P := Point(Button1.Left + Button1.Width div 2, Button1.Top + Button1.Height div 2); P := Form1.ClientToScreen(p); SetCursorPos(p.x, p.y); P := Point(round(p.x * 65535 / Screen.Width), Round(p.y * 65535 / Screen.Height)); Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, P.x, p.y, 0, 0); Application.ProcessMessages; Sleep(100); Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, P.x, p.y, 0, 0); Application.ProcessMessages; Sleep(300); Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, P.x, p.y, 0, 0); End;

Перемещать объект на сложном фоне.

Написать графический редактор, как Paint Brush, в Delphi очень просто. Но встает одна проблема. Чтобы нарисовать линию, пользователь нажимает мышью на поле, двигает ее, и отпускает кнопку. Во время движения мыши линия все время перерисовывается. Причем фон, после того, как линия переместилась, должен восстановиться. Для этого можно использовать логическую операцию XOR. Важное свойство этой операции заключается в том, что при любых A и B, A XOR B XOR B = A. Это означает, что если воспользоваться этой операцией для рисования линии, то при повторном ее рисовании на этом месте этим же цветом она сотрется, оставив за собой прежний фон.

Code: Procedure TForm1.XORLine; Begin. Form1.Canvas.MoveTo(xo, yo); Form1.Canvas.LineTo(lx, ly); End; Procedure TForm1.FormCreate(Sender: TObject); Begin. Form1.Color := clWhite; Form1.Canvas.Pen.Color := clRed; Form1.Canvas.Pen.Width := 3; End; Procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. Form1.Tag := 1; Xo := X; Yo := Y; Lx := X; Ly := Y; Form1.Canvas.Pen.Mode := pmNotXor; XORLine; End; Procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Begin. If ssLeft in Shift then begin. XORLine; Lx := X; Ly := Y; XORLine; End; End; Procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Begin. Form1.Canvas.Pen.Mode := pmCopy; Form1.Canvas.MoveTo(xo, yo); Form1.Canvas.LineTo(X, Y); End;

Узнать о завершении работы Windows.

Если текст в Memo1 был изменен, то программа не разрешает завершения сеанса Windows.

Code: ... Private. Procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; ... Procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession); Begin. Msg.Result := integer(not Memo1.Modified); End;

©Drkb::01673.

Автор советов: Даниил Карапетян.

E-mail: delphi4all@narod.ru.

Автор справки: Алексей Денисов.

E-mail: aleksey@sch103.krasnoyarsk.su.

Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна.

Автор: Nomadic.

Объектно-ориентированное программирование (статья).

Эта статья была скачена в интернете, и к сожалению я не нашёл указаний на авторство.

Введение.

Краеугольные камни ООП.

Наследование.

Метаклассы.

Как узнать путь к браузеру по умолчанию?

Code: Uses. Registry; {....} Procedure TForm1.Button1Click(Sender: TObject); Var. Reg: TRegistry; KeyName: string; ValueStr: string; Begin. Reg := TRegistry.Create; Try. Reg.RootKey := HKEY_CLASSES_ROOT; KeyName := 'htmlfile\shell\open\command'; If Reg.OpenKey(KeyName, False) then. Begin. ValueStr := Reg.ReadString(''); Reg.CloseKey; Label1.Caption := ValueStr; End. Else. ShowMessage('No Default Webbrowser !'); Finally. Reg.Free; End; End;

Введение.

Объектно-ориентированное программирование (ООП).

Объекты – это крупнейшее достижение в современной технологии программирования. Смеем утверждать, что изобретение и практическая реализация объектов являются подвигом человеческого гения. Это не пустые слова: объекты позволили строить программу не из чудовищных по сложности процедур и функций, а из кирпичиков-объектов, заранее наделенных нужными свойствами. Самое приятное в этом то, что внутренняя сложность объектов скрыта от программиста, он просто пользуется готовым строительным материалом.

Краеугольные камни ООП.

КРАЕУГОЛЬНЫЕ КАМНИ ООП.

ФОРМУЛА ОБЪЕКТА.

Авторы надеются, что читатель помнит кое-что из второй главы и такие понятия, как тип данных, процедура, функция, запись для него не в новинку. Это прекрасно. Та вот, в конце 60-х годов кому-то пришло в голову объединить эти понятия и то, что получилось, назвать объектом. Рассмотрение данных в неразрывной связи с методами их обработки позволило вывести формулу объекта:

Объект = Данные + Операции.

На основании этой формулы была разработана методология объектно-ориентированного программирования (ООП).

ПРИРОДА ОБЪЕКТА.

Наследование.

НАСЛЕДОВАНИЕ.

ПОНЯТИЕ НАСЛЕДОВАНИЯ.

Классы инкапсулируют (т.е. включают в себя) поля, методы и свойства; это их первая черта. Следующая не менее важная черта классов — способность наследовать поля, методы и свойства других классов. Чтобы пояснить сущность наследования, обратимся к примеру с измерителями ресурсов.

Класс TDiskGauge описывает измеритель дискового ресурса и непригоден для измерения ресурса другого типа, например оперативной памяти. С появлением измерителя оперативной памяти нужен новый класс объектов:

Code: Type. TMemoryGauge = class. FPercentCritical: Integer; Constructor Create; Function GetPercentFree: Integer; Procedure SetPercentCritical (Value: Integer) ; Procedure CheckStatus; Property PercentFree: Integer read GetPercentFree; Property PercentCritical: Integer. Read FPercentCritical write SetPercentCritical; End;

Метаклассы.

МЕТАКЛАССЫ.

ССЫЛКИ НА КЛАССЫ.

Язык Object Pascal позволяет рассматривать классы как своего рода объекты, которыми можно манипулировать в программе. Такая возможность рождает новое понятие — класс класса; его принято обозначать термином метакласс.

Для поддержки метаклассов введен специальный тип данных — ссылка на класс (class reference). Он описывается с помощью словосочетания class of, например:

Code: Type. TResourceGaugeClass = class of TResourceGauge;

Переменная типа TResourceGaugeClass объявляется в программе обычным образом:

Code: Var. ClassRef: TResourceGaugeClass;

Доступ к COM серверам Microsoft Office из Delphi 5 (Статья).

Доступ к COM серверам Microsoft Office из Delphi 5.

(С) И. Мирончик,

Независимый разработчик и.

Преподаватель курсов.

По Delphi, C++Builder, Oracle.

E-maile EKSKHQ@Elsite.ru.

Эта статья была опубликована на сайте http://www.borland.ru/

Введение.

В статье рассматривается вопрос доступа к общеизвестным приложениям Microsoft Office, таким как Word, Excel, Outlook и другим, через новый набор компонент, представленных в Delphi 5. Для начала работы нам предстоит установить на компьютере приложения Microsoft Office 97 – Excel, Word, Outlook, PowerPoint. Если считаете необходимым, то можно добавить и Access (но с ним у меня особые счеты). Ну и конечно устанавливается новый продукт Delphi 5. Кроме множества изменений в нем имеется одно, для нас сейчас необходимое – новая закладка на палитре инструментов – Servers.Через эти компоненты мы будем получать доступ к COM серверам приложений Office, использующих автоматизацию (прежде известную как OLE Automation).

Мы рассмотрим несколько примеров построения контроллеров автоматизации для создания отчетов в MS Word, производство расчетов и построение диаграмм в MS Excel, а так же формирование рассылки писем адресатам через MS Outlook.

Приложения и объекты MS Office. Обзор.

Office – это среда, в которой большинство задач можно решать без какого-либо программирования. Но вся ценность приложений Office для разработчика заключается в том, что все, что можно сделать руками, можно сделать программным путем с использованием средств VBA (Visual Basic for Application). Кроме того, приложения Office поставляют сервера COM, которые предоставляют интерфейс доступа к приложению и его объектам. Благодаря этому, разработчик в среде Delphi имеет возможность, создав контроллер автоматизации, управлять сервером. Так как устроено приложение в Office? На самом деле приложение рассматривается как совокупность объектов со своими методами, свойствами, событиями, которые обеспечивают скелет приложения. Программист Office является не создателем приложения, как, например это делается в Delphi, а он принимает участие в создании системы документов. Таким образом, ДОКУМЕНТ, а не программа являются целью разработки.

Наследование – мощный инструмент построения нового класса, однако программистам известен еще один способ получения класса – встраивание. Как и наследование, встраивание транзитивное отношение. В объектной модели Office нет наследования в полном смысле этого слова, а есть только встраивание.

Всегда существует задающий приложение корневой объект, он всегда называется Application. Каждое приложение Office имеет свой собственный корневой объект – Word.Application, Excel.Application. Outlook приложение само является корневым объектом, несмотря на это в объект Application встраиваются все остальные объекты (участники), которые являются свойствами главного объекта. Участником могут быть свои участники и так далее. В документе методов очень много, причем самых разных, но имеются и одинаковые методы в различных приложениях Office. Среди таковых – Run, Quit, Activate; но даже и они в разных приложениях имеют различный набор параметров, а зачастую.

Выполняют не адекватные действия. Такое многообразие различных реализаций классов отпугивало программистов контроллеров автоматизации. Однако, используя компоненты доступа к серверам автоматизации – положение резко улучшилось. На следующем рисунке показан очень маленький фрагмент структуры объекта Microsoft Word Objects. Более полное представление об объектной архитектуре приложений Office можно найти в соответствующих файлах помощи.

Как только открывается новый документ, будь то PowerPoint, Excel, Word, автоматически создается каркас нового документа, который представляет собой набор библиотек с классами. Объекты этих классов будут доступны в данном документе. Задачей разработчика контроллера автоматизации является получить доступ к корневому объекту сервера, выстроить цепочку доступа к объектам – участникам (встроенным объектам), правильно передать параметры.

Объекты Application и организация доступа к ним из Delphi.

Я, наверное, утомил читателя устройством приложений Office. Но все-таки необходимо еще раз отметить, что всех объектов этого семейства не перечесть, но главные необходимо знать и уметь ими пользоваться. Фундаментальным объектом любого приложения является Application. Давайте получим к нему доступ из Delphi.

• Создаем новый проект

• На главную форму выкладываем компоненту с закладки Servers, которая называется WordApplication

• Устанавливаем свойства компоненты AutoConnect и AutoQuit в True

• Запускаем приложение на выполнение.

Казалось бы, ничего не произошло, запустилась форма и отобразилась на экране, на самом деле наше приложение запустило сервер автоматизации Microsoft Word, этот факт можно обнаружить, запустив на выполнение Task Manager и выбрав закладку Processes. Среди прочих процессов мы обнаруживаем WINWORD.EXE. На самом деле была приложением проделана следующая работа:

1. При создании формы, в системном реестре, по идентификатору CLSID был найден сервер Word.Application

2. Запущено на выполнение приложение, находящееся по адресу в реестре (ProgID)

3. Сервер предоставил нашему приложению, которое и является контроллером автоматизации интерфейс, через который мы и получим доступ к объекту Application.

4. Интерфейс Idispatch унаследован от Iunknown, который в свою очередь имеет три метода, один из которых _ADDRef умеет считать количество клиентов, в настоящий момент использующих сервер. Как только от сервера отсоединиться последний клиент, он автоматически будет выгружен из памяти компьютера.

Закройте наше приложение и загляните в Task Manager - Word выгрузился из памяти.

Точно такой же результат можно было бы получить, прописав следующий код:

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. Wd:OleVariant; FileName:string; Begin. Try. FileName:=ExtractFilePath(Application.EXEName)+'report.DOC'; //Создаем объект интерфейса для доступа к серверу COM. Wd:=CreateOleObject('Word.Application'); //Проверка наличия методов и правильность передачи параметров будет. //осуществляться на стадии выполнения приложения. Wd.application.documents.add; Wd.application.activedocument.range.insertAfter(now); Wd.application.activedocument.saveas(fileName); //выгрузаем сервер из памяти компьютера. Wd.application.quit(true,0); ….

Что такое множества?

Множества - это наборы однотипных логически связанных друг с другом объектов. Характер связей между объектами лишь подразумевается программистом и никак не контролируется Object Pascal. Количество элементов, входящих в множество, может меняться в пределах от 0 до 256 (множество, не содержащее элементов, называется пустым). Именно непостоянством количества своих элементов множества отличаются от массивов и записей.

Два множества считаются эквивалентными тогда и только тогда, когда все их элементы одинаковы, причем порядок следования элементов в множестве безразличен. Если все элементы одного множества входят также и в другое, говорят о включении первого множества во второе. Пустое множество включается в любое другое.

Пример определения и задания множеств:

Code: Type. DigitChar = set of '0'..'9'; Digit = set of 0. .9; Var. Sl,s2,s3 : digitChar; S4,s5,s6 : digit; Begin. Si := ['1', '2', '3']; S2 := ['3', '2', '1']; S3 := ['2', '3']; S4 := [0..3, 6]; S5 := [4, 5]; S6 := [3..9]; End.

В этом примере множества si и s2 эквивалентны, а множество S3 включено в s 2 , но не эквивалентно ему.

Описание типа множества имеет вид:

<имя типа> = set of <базовый тип>;

Здесь <имя типа> - правильный идентификатор; set, of - зарезервированные слова (множество, из); <базовый тип> - базовый тип элементов множества, в качестве которого может использоваться любой порядковый тип, кроме Word, Integer, Longint, Int64.

Для задания множества используется так называемый конструктор множества: список спецификаций элементов множества, отделенных друг от друга запятыми; список обрамляется квадратными скобками. Спецификациями элементов могут быть константы или выражения базового типа, а также тип-диапазон того же базового типа.

Над множествами определены следующие операции:

* пересечение множеств; результат содержит элементы, общие для обоих множеств; например, s4*s6 содержит [3], s4*s5 -пустое множество (см. выше);

+ объединение множеств; результат содержит элементы первого множества, дополненные недостающими элементами из второго множества:

S4+S5 содержит [0,1,2,3,4,5,6];

S5+S6 содержит [3, 4, 5, 6, 7, 8, 9] ;

Разность множеств; результат содержит элементы из первого множества, которые не принадлежат второму:

S6-S5 содержит [3,6,7,8,9];

S4-S5 содержит [0,1, 2, 3, 6] ;

= проверка эквивалентности; возвращает True, если оба множества эквивалентны;

<> проверка неэквивалентности; возвращает True, если оба множества неэквивалентны;

<= проверка вхождения; возвращает True, если первое множество включено во второе;

>= проверка вхождения; возвращает True, если второе множество включено в первое;

In проверка принадлежности; в этой бинарной операции первый элемент - выражение, а второй - множество одного и того же типа; возвращает True, если выражение имеет значение, принадлежащее множеству:

3 in s 6 возвращает True;

2*2 in si возвращает False.

Дополнительно к этим операциям можно использовать две процедуры.

Include - включает новый элемент во множество. Обращение к процедуре:

Include(S,I).

Здесь s - множество, состоящее из элементов базового типа TSet Base; I - элемент типа TSetBase, который необходимо включить во множество.

Exclude - исключает элемент из множества. Обращение:

Exclude(S,I).

Параметры обращения - такие же, как у процедуры include. В отличие от операций + и -, реализующих аналогичные действия над двумя множествами, процедуры оптимизированы для работы с одиночными элементами множества и поэтому отличаются высокой скоростью выполнения.

Учебная программа PRIMSET.

В следующем примере, иллюстрирующем приемы работы с множествами, реализуется алгоритм выделения из первой сотни натуральных чисел всех простых чисел[ Простыми называются целые числа, которые не делятся без остатка на любые другие целые числа, кроме 1 и самого себя. К простым относятся 1, 2, 3, 5, 7, 11, 13 и т. д.. ]. В его основе лежит прием, известный под названием "решето Эратосфена". В соответствии с этим алгоритмом вначале формируется множество BeginSet, состоящее из всех целых чисел в диапазоне от 2 до N. В множество primerset (оно будет содержать искомые простые числа) помещается 1. Затем циклически повторяются следующие действия:

Взять из BeginSet первое входящее в него число Next и поместить его В PrimerSet;

Удалить из BeginSet число Next и все другие числа, кратные ему, Т. е. 2*Next, 3*Next И Т.Д.

Цикл повторяется до тех пор, пока множество BeginSet не станет пустым.

Эту программу нельзя использовать для произвольного N, так как в любом множестве не может быть больше 256 элементов.

Code: Procedure TfmExample.bbRunClick(Sender: TObject); // Выделение всех простых чисел из первых N целых. Const. N = 255; // Количество элементов исходного множества. Type. SetOfNumber = set of 1..N; Var. N1,Next,i: Word; // Вспомогательные переменные. BeginSet, // Исходное множество. PrimerSet: SetOfNumber; // Множество простых чисел. S : String; Begin. BeginSet := [2..N]; // Создаем исходное множество. PrimerSet:= [1]; // Первое простое число. Next := 2; // Следующее простое число. While BeginSet о [ ] do // Начало основного цикла. Begin. Nl := Next; //nl-число, кратное очередному простому (Next). // Цикл удаления из исходного множества непростых чисел: While nl <= N do. Begin. Exclude(BeginSet, nl); N1 := nl + Next // Следующее кратное. End; // Конец цикла удаления. Include(PrimerSet, next); // Получаем следующее простое, которое есть первое. // число, не вычеркнутое из исходного множества. Repeat. Inc(Next). Until (Next in BeginSet) or (Next > N). End; // Конец основного цикла. // Выводим результат: S := '1'; For i := 2 to N do. If i in PrimerSet then. S := S+', '+IntToStr(i); MmOutput.Lines.Add(S). End;

Перед тем как закончить рассмотрение множеств, полезно провести небольшой эксперимент. Измените описание типа SetOfNumber следующим образом:

Code: Type SetOfNumber = set of 1..1;

И еще раз запустите программу из предыдущего примера. На экран будет выведено 1, 3, 5, 7.

Множества BeginSet и PrimerSet состоят теперь из одного элемента, а программа сумела поместить в них не менее семи!

Секрет этого прост: внутреннее устройство множества таково, что каждому его элементу ставится в соответствие один двоичный разряд (один бит); если элемент включен во множество, соответствующий разряд имеет значение 1, в противном случае - 0. В то же время минимальной единицей памяти является один байт, содержащий 8 бит, поэтому компилятор выделил множествам по одному байту, и в результате мощность каждого из них стала равна 8 элементам. Максимальная мощность множества - 256 элементов. Для таких множеств компилятор выделяет по 16 смежных байт.

И еще один эксперимент: измените диапазон базового типа на 1..256. Хотя мощность этого типа составляет 256 элементов, при попытке компиляции программы компилятор сообщит об ошибке: Sets may have at most 256 elements (Множества могут иметь не более 256 элементов) т. к. нумерация элементов множества начинается с нуля независимо от объявленной в программе нижней границы. Компилятор разрешает использовать в качестве базового типа целочисленный тип-диапазон с минимальной границей 0 и максимальной 255 или любой перечисляемый тип не более чем с 256 элементами (максимальная мощность перечисляемого типа - 65536 элементов).

©Drkb::00260.

Как выключить master volume в звуковой карте?

Code: Uses. MMSystem; Function GetMasterMute( Mixer: hMixerObj; Var Control: TMixerControl): MMResult; // Returns True on success. Var. Line: TMixerLine; Controls: TMixerLineControls; Begin. ZeroMemory(@Line, SizeOf(Line)); Line.cbStruct := SizeOf(Line); Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS; Result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE); If Result = MMSYSERR_NOERROR then. Begin. ZeroMemory(@Controls, SizeOf(Controls)); Controls.cbStruct := SizeOf(Controls); Controls.dwLineID := Line.dwLineID; Controls.cControls := 1; Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE; Controls.cbmxctrl := SizeOf(Control); Controls.pamxctrl := @Control; Result := mixerGetLineControls(Mixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE); End; End; Procedure SetMasterMuteValue( Mixer: hMixerObj; Value: Boolean); Var. MasterMute: TMixerControl; Details: TMixerControlDetails; BoolDetails: TMixerControlDetailsBoolean; Code: MMResult; Begin. Code := GetMasterMute(0, MasterMute); If Code = MMSYSERR_NOERROR then. Begin. With Details do. Begin. CbStruct := SizeOf(Details); DwControlID := MasterMute.dwControlID; CChannels := 1; CMultipleItems := 0; CbDetails := SizeOf(BoolDetails); PaDetails := @BoolDetails; End; LongBool(BoolDetails.fValue) := Value; Code := mixerSetControlDetails(0, @Details, MIXER_SETCONTROLDETAILSF_VALUE); End; If Code <> MMSYSERR_NOERROR then. Raise Exception.CreateFmt('SetMasterMuteValue failure, '+ 'multimedia system error #%d', [Code]); End; // Example: Procedure TForm1.Button1Click(Sender: TObject); Begin. SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off. End;

Как нарисовать повёрнутый текст.

Code: 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;

Как отловить CLX форму?

Code: { Capturing a CLX form is easy, once you know. It took me a little time to find out, so I'm giving the knowledge to help others : } Type. TFormCapturable = class(TForm). Public. Procedure PrintOne; End; Var. FormCapturable: TFormCapturable; Implementation. Uses. Qt; Procedure TFormCapturable.PrintOne; Var. ABitmap : TBitmap; AWinHandle : QWidgetH; AWinId : Cardinal; X, y, w, h : integer; Begin. // create a new bitmap to hold the captured screen. ABitMap := TBitmap.Create; Try. // get a handle on the desktop. AWinHandle := QApplication_desktop; // get the Id from the desktop handle. AWinId := QWidget_winId( aWinHandle); // get the position and size of the windows. X := Self.Left; Y := Self.Top; W := Self.Width; H := Self.Height; // capture the window into the bitmap's pixmap. QPixmap_grabWindow( aBitmap.Handle, aWinId, x, y, w, h); // save the bitmap. ABitMap.SaveToFile( 'c:\temp\test.bmp'); Finally. // don't forget to kill the bitmap after use. FreeAndNil( aBitMap); End; End;

Как получить имя текущего пользователя?

Code: Function GetCurrentUser: string; Var. Pwrec: PPasswordRecord; Begin. Pwrec := getpwuid(getuid); Result := pwrec.pw_name; End;

Как перехватывать kernel-signals?

Code: Program TestSignals; {$APPTYPE CONSOLE}. Uses. Libc; Var. BTerminate: Boolean; Procedure SignalProc(SigNum: Integer); cdecl; Begin. Case SigNum of. SIGQUIT: Begin. WriteLn('signal SIGQUIT'); BTerminate := true; End; SIGUSR1: WriteLn('signal SIGUSR1'); Else. WriteLn('not handled signal'); End; Signal(SigNum, SignalProc); // catch the signal again. End; Begin. BTerminate := false; Signal(SIGQUIT, SignalProc); // catch the signal SIGQUIT to procedure SignalProc. Signal(SIGUSR1, SignalProc); // catch the signal SIGUSR1 to procedure SignalProc. Repeat. Sleep(1); Until bTerminate; End.

Как использовать ресурсы?

Code: { To create resource files (*.res) for Kylix you can use the Delphi. Brcc32.exe resource compiler. Take a look at ;http://www.swissdelphicenter.ch/en/showcode.php?id=1049. Kylix dont support userdefined resourcetypes. Therefore you have to define. All resources without a predefined ResType as RCDATA. Example with TResourceStream. Saves the resource (in userdefined.res) with the name MYRES1 to the file. Test.txt. } Uses. SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs, QStdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Procedure Button1Click(Sender: TObject); Private. { Private-Deklarationen }. Public. { Public-Deklarationen }. End; Var. Form1: TForm1; Implementation. {$R *.xfm}. {$R userdefined.res}. Procedure TForm1.Button1Click(Sender: TObject); Var. Stream: TResourceStream; Begin. Stream := TResourceStream.Create(HInstance, 'MYRES1', RT_RCDATA); With TFileStream.Create('test.txt', fmCreate) do begin. CopyFrom(stream, stream.Size); Free; End; End;

Как клонировать процесс?

Code: { In Linux it is possible to duplicate a process with fork. In the original. Process, fork will return the handle to the duplicated process. The. Duplicated process will return zero. } Program TestFork; {$APPTYPE CONSOLE}. Uses. SysUtils, Libc; Var. ForkedProcessHandle: __pid_t; BForked: Boolean; Procedure ForkNow; Begin. BForked := true; ForkedProcessHandle := fork; End; Function IsForked: Boolean; Begin. Result := (ForkedProcessHandle = 0) and bForked; End; Var. Lf: Integer; Begin. Sigignore(SIGCHLD); BForked := false; WriteLn('do some stuff'); WriteLn('before fork'); ForkNow; WriteLn('after fork - we have dublicated the process'); If IsForked then begin. WriteLn('do some stuff in forked process (wait 5s)'); For Lf := 0 to 50 do begin. Write('f'); Sleep(100); End; End else begin. WriteLn('do stuff in original process (wait 10)'); For Lf := 0 to 100 do begin. Write('o'); Sleep(100); End; End; WriteLn; If IsForked then. WriteLn('forked process end'). Else. WriteLn('original process end'); End. { Output of this demo app: Do some stuff. Before fork. After fork - we have dublicated the process. After fork - we have dublicated the process. Do some stuff in forked process (wait 5s). Fdo stuff in original process (wait 10). Ooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooff. Ooffooffooffooffooffooffooffoo. Forked process end. Ooooooooooooooooooooooooooooooooooooooooooooooooo. Original process end. }

Предпросмотр/печать TRichEdit.

Чтобы вывести Rich Edit на любой канвас, нужно использовать стандартное сообщение EM_FORMATRANGE.

LParam пареметр этого сообщения содержит указатель на структуру TFormatRange.

Перед посылкой сообщения нужно заполнить эту структуру:

Hdc - контекст устройства, на который будет выводиться Rich Edit.

HdcTarget - контекст устройства, в соответствии с которым будет производиться форматирование текста.

Rc - область, в которую будет выводиться Rich Edit. Единицы измерения - твипсы (twips). Twips = 1/1440 дюйма.

RcPage - полная область вывода устройства (в твипсах).

Chrg - указывает диапазон выводимого текста.

Chrg.cpMin и chrg.cpMax - позиции символов, определяющие кусок текста (не включая сами cpMin и cpMax)...

Code: Function PrintRTFToBitmap(ARichEdit : TRichEdit; ABitmap : TBitmap) : Longint; Var. Range : TFormatRange; Begin. FillChar(Range, SizeOf(TFormatRange), 0); // Rendering to the same DC we are measuring. Range.hdc := ABitmap.Canvas.handle; Range.hdcTarget := ABitmap.Canvas.Handle; // Set up the page. Range.rc.left := 0; Range.rc.top := 0; Range.rc.right := ABitmap.Width * 1440 div Screen.PixelsPerInch; Range.rc.Bottom := ABitmap.Height * 1440 div Screen.PixelsPerInch; // Default the range of text to print as the entire document. Range.chrg.cpMax := -1; Range.chrg.cpMin := 0; // format the text. Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range)); // Free cached information. SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0); End;

©Drkb::00578.

Следующий пример покажет, как вывести Rich Edit не только на любой канвас, но и также, как вывести только определённый кусок текста...

Code: Function PrintToCanvas(ACanvas : TCanvas; FromChar, ToChar : integer; ARichEdit : TRichEdit; AWidth, AHeight : integer) : Longint; Var. Range : TFormatRange; Begin. FillChar(Range, SizeOf(TFormatRange), 0); Range.hdc := ACanvas.handle; Range.hdcTarget := ACanvas.Handle; Range.rc.left := 0; Range.rc.top := 0; Range.rc.right := AWidth * 1440 div Screen.PixelsPerInch; Range.rc.Bottom := AHeight * 1440 div Screen.PixelsPerInch; Range.chrg.cpMax := ToChar; Range.chrg.cpMin := FromChar; Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range)); SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0); End;

©Drkb::00579.

А как вывести Rich-текст с фоновым рисунком ?

Рисуем по-отдельности фоновый рисунок и содержимое TRichEdit, а потом их соединяем...

Code: Procedure TForm1.Button2Click(Sender: TObject); Var Bmp : TBitmap; Begin. Bmp := TBitmap.Create; Bmp.Width := 300; Bmp.Height := 300; PrintToCanvas(bmp.Canvas,2,5,RichEdit1,300,300); BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, srcAND); Image1.Repaint; Bmp.Free; End;

Как сделать mount?

Code: { The following example shows a Linux-Console application, which mount. The floppy. } Program Project1; {$APPTYPE CONSOLE}. Uses. Libc; Begin. If mount('/dev/fd0', '/mnt/floppy', 'vfat', MS_RDONLY, nil) = -1 then. WriteLn('Mount return : ', Errno, '(', strerror(errno), ')'). Else. WriteLn('Floppy mounted'); End.

Как отлаживать консольные приложения?

As with Delphi you can use Kylix to write console applications even though many.

People think that's not important. ;-).

When you start a console program in the Delphi Debugger it automatically opens.

A console window ("DOS command prompt") where you can see the output of e.g.

The writeln command.

Kylix doesn't do that automatically and if you don't look hard enough you might.

Think it is impossible to debug console applications with it.

But if you open the run / parameters dialog you will find an entry called.

"Use Launcher Application" that is prefilled with xconsole. Just tick this.

Option and there you go.

©Drkb::04618.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Как запустить другое приложение?

Code: Uses. Libc; Procedure TForm1.Button1Click(Sender: TObject); Var. IPrg: Integer; Begin. //Execute kcalc - A calculator for KDE. IPrg := libc.system('kcalc'); If iPrg = -1 then. ShowMessage('Error executing your program'); End;

Как показать оставшееся время до конца?

Code: Procedure TForm1.Timer1Timer(Sender: TObject); Var. TheLength,Posi,SummaMin,SummaSec: Integer; Begin. //Progress Bar to check if the track is playing. If Progress.Max<>0 then Begin. Progress.Position := Mediaplayer1.Position; //Gets the length of the selected track. TheLength := Mediaplayer1.TrackLength[ListBox1.ItemIndex]; //gets the current position of the track. Posi := Mediaplayer1.Position; //Caculates Minutes. SummaMin := ((TheLength - Posi) div 1000) Div 60; //Calculates Seconds. SummaSec := ((TheLength - Posi) Div 1000) Mod 60; //Adds zero if Seconds are less then ten. If SummaSec < 10 Then. Label2.Caption := '0' + IntToStr(SummaSec). Else. Label2.Caption := IntToStr(SummaSec); //Minutes. Label1.Caption := IntToStr(SummaMin); End;

©Drkb::01314.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Как найти наибольший общий делитель?

Code: { The greatest common factor, or GCF, is the greatest factor. That divides two numbers. } Uses. Math; // Find the greatest common factor of two integers. Function TForm1.GCF(A, B: Integer): Integer; Var. Lfactor: Integer; Begin. // Return -1 if either value is zero or negative. If (A < 1) or (B < 1) then. Begin. Result := -1; Exit; End; // if A = B then this is the GCF. If A = B then. Begin. Result := A; Exit; End; Result := 1; For Lfactor := trunc(max(A, B) / 2) downto 2 do. Begin. If (frac(A / Lfactor) = 0) and (frac(B / Lfactor) = 0) then. Begin. Result := Lfactor; Exit; // GCF has been found. No need to continue. End; End; End; // Example: Procedure TForm1.Button1Click(Sender: TObject); Var. Res: Integer; Begin. Res := GCF(120, 30); ShowMessage(Inttostr(Res)); End; {******************} // Find the greatest common factor of an array of integers. Function TForm1.GCFarray(A: array of Integer): Integer; Var. Llength, Lindex, Lfactor: Integer; Begin. Llength := Length(A); // Return -1 if any value is zero or negative. For Lindex := 0 to Llength - 1 do. Begin. If A[Lindex] < 1 then. Begin. Result := -1; Exit; End; End; // if all elements are equal then this is the GCF. Lindex := 1; While (Lindex < Llength) and (A[Lindex] = A[0]) do Inc(Lindex); If Lindex = Llength then. Begin. Result := A[0]; Exit; End; Result := 1; For Lfactor := trunc(ArrayMax(A) / 2) downto 2 do. Begin. Lindex := 0; While (Lindex < Llength) and. (frac(A[Lindex] / Lfactor) = 0) do Inc(Lindex); If Lindex = Llength then. Begin. Result := Lfactor; Exit; // GCF has been found. No need to continue. End; End; End; // find the maximum value in an array of integers. Function TForm1.ArrayMax(Aarray: array of Integer): Integer; Var. Lpos: Integer; Begin. Result := 0; For Lpos := 0 to Length(Aarray) - 1 do. If Aarray[Lpos] > Result then. Result := Aarray[Lpos]; End;

Как посчитать возраст человека?

Code: Function CalculateAge(Birthday, CurrentDate: TDate): Integer; Var. Month, Day, Year, CurrentYear, CurrentMonth, CurrentDay: Word; Begin. DecodeDate(Birthday, Year, Month, Day); DecodeDate(CurrentDate, CurrentYear, CurrentMonth, CurrentDay); If (Year = CurrentYear) and (Month = CurrentMonth) and (Day = CurrentDay) then. Begin. Result := 0; End. Else. Begin. Result := CurrentYear - Year; If (Month > CurrentMonth) then. Dec(Result). Else. Begin. If Month = CurrentMonth then. If (Day > CurrentDay) then. Dec(Result); End; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Label1.Caption := Format('Your age is %d', [CalculateAge(StrToDate('01.01.1903'), Date)]); End;

Как проверить правильность International Bank Account Number?

Code: // IBAN = International Bank Account Number. // Example : CH10002300A1023502601. Function ChangeAlpha(input: string): string; // A -> 10, B -> 11, C -> 12 ... Var. A: Char; Begin. Result := input; For a := 'A' to 'Z' do. Begin. Result := StringReplace(Result, a, IntToStr(Ord(a) - 55), [rfReplaceAll]); End; End; Function CalculateDigits(iban: string): Integer; Var. V, l: Integer; Alpha: string; Number: Longint; Rest: Integer; Begin. Iban := UpperCase(iban); If Pos('IBAN', iban) > 0 then. Delete(iban, Pos('IBAN', iban), 4); Iban := iban + Copy(iban, 1, 4); Delete(iban, 1, 4); Iban := ChangeAlpha(iban); V := 1; L := 9; Rest := 0; Alpha := ''; Try. While v <= Length(iban) do. Begin. If l > Length(iban) then. L := Length(iban); Alpha := alpha + Copy(iban, v, l); Number := StrToInt(alpha); Rest := number mod 97; V := v + l; Alpha := IntToStr(rest); L := 9 - Length(alpha); End; Except. Rest := 0; End; Result := rest; End; Function CheckIBAN(iban: string): Boolean; Begin. Iban := StringReplace(iban, ' ', '', [rfReplaceAll]); If CalculateDigits(iban) = 1 then. Result := True. Else. Result := False; End;

©Drkb::04046.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Base64 кодирование.

Code: Function Decode(const S: AnsiString): AnsiString; Const. Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); Var. I: LongInt; Begin. Case Length(S) of. 2: Begin. I := Map[S[1]] + (Map[S[2]] shl 6); SetLength(Result, 1); Move(I, Result[1], Length(Result)). End; 3: Begin. I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12); SetLength(Result, 2); Move(I, Result[1], Length(Result)). End; 4: Begin. I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) + (Map[S[4]] shl 18); SetLength(Result, 3); Move(I, Result[1], Length(Result)). End. End. End;

Как узнать IP клиента и IP сервера для активного RAS-подключения?

Code: Uses Ras, RasError; {©Drkb v.3(2007): www.drkb.ru}. Type. TRASIP = record. DwSize: DWORD; DwError: DWORD; SzIpAddress: packed array[0..RAS_MaxIpAddress] of AnsiChar; SzServerIpAddress: packed array[0..RAS_MaxIpAddress] of AnsiChar; End; Procedure GetDialUpIpAddress(var server, client: string); Var. RASPppIp: TRASIP; Lpcp: DWORD; ConnClientIP: array[0..RAS_MaxIpAddress] of Char; ConnServerIP: array[0..RAS_MaxIpAddress] of Char; Entries: PRasConn; BufSize, NumberOfEntries, Res: DWORD; RasConnHandle: THRasConn; Begin. New(Entries); BufSize := Sizeof(Entries^); ZeroMemory(Entries, BufSize); Entries^.dwSize := Sizeof(Entries^); Res := RasEnumConnections(Entries, BufSize, NumberOfEntries); If Res = ERROR_BUFFER_TOO_SMALL then. Begin. ReallocMem(Entries, BufSize); ZeroMemory(Entries, BufSize); Entries^.dwSize := Sizeof(Entries^); Res := RasEnumConnections(Entries, BufSize, NumberOfEntries); End; Try. If (Res = 0) and (NumberOfEntries > 0) then RasConnHandle := Entries.hrasconn else exit. Finally. FreeMem(Entries); End; FillChar(RASPppIp, SizeOf(RASPppIp), 0); RASPppIp.dwSize := SizeOf(RASPppIp); Lpcp := RASPppIp.dwSize; If RasGetProjectionInfo(RasConnHandle, RASP_PppIp, @RasPppIp, lpcp) = 0 then. Begin. Move(RASPppIp.szServerIpAddress, ConnServerIP, SizeOf(ConnServerIP)); Server := ConnServerIP; Move(RASPppIp.szIpAddress, ConnClientIP, SizeOf(ConnClientIP)); Client := ConnClientIP; End; End;

Как представить число в другой системе счисления?

Code: Function BaseConvert(NumIn: string; BaseIn: Byte; BaseOut: Byte): string; Var. I: integer; CurrentCharacter: char; CharacterValue: Integer; PlaceValue: Integer; RunningTotal: Double; Remainder: Double; BaseOutDouble: Double; NumInCaps: string; S: string; Begin. If (NumIn = '') or (BaseIn < 2) or (BaseIn > 36) or (BaseOut < 1) or (BaseOut > 36) then. Begin. Result := 'Error'; Exit; End; NumInCaps := UpperCase(NumIn); PlaceValue := Length(NumInCaps); RunningTotal := 0; For i := 1 to Length(NumInCaps) do. Begin. PlaceValue := PlaceValue - 1; CurrentCharacter := NumInCaps[i]; CharacterValue := 0; If (Ord(CurrentCharacter) > 64) and (Ord(CurrentCharacter) < 91) then. CharacterValue := Ord(CurrentCharacter) - 55; If CharacterValue = 0 then. If (Ord(CurrentCharacter) < 48) or (Ord(CurrentCharacter) > 57) then. Begin. BaseConvert := 'Error'; Exit; End. Else. CharacterValue := Ord(CurrentCharacter); If (CharacterValue < 0) or (CharacterValue > BaseIn - 1) then. Begin. BaseConvert := 'Error'; Exit; End; RunningTotal := RunningTotal + CharacterValue * (Power(BaseIn, PlaceValue)); End; While RunningTotal > 0 do. Begin. BaseOutDouble := BaseOut; Remainder := RunningTotal - (int(RunningTotal / BaseOutDouble) * BaseOutDouble); RunningTotal := (RunningTotal - Remainder) / BaseOut; If Remainder >= 10 then. CurrentCharacter := Chr(Trunc(Remainder + 55)). Else. Begin. S := IntToStr(trunc(remainder)); CurrentCharacter := s[Length(s)]; End; Result := CurrentCharacter + Result; End; End; // Example, Beispiel. Procedure TForm1.Button1Click(Sender: TObject); Begin. BaseConvert('FFFF', 16, 10); // returns, ergibt '65535'. End;

Как нарисовать фрактал?

Code: Procedure DrawMandelbrot(ACanvas: TCanvas; X, Y, au, bu: Double; X2, Y2: Integer); Var. C1, c2, z1, z2, tmp: Double; I, j, Count: Integer; Begin. C2 := bu; For i := 10 to X2 do. Begin. C1 := au; For j := 0 to Y2 do. Begin. Z1 := 0; Z2 := 0; Count := 0; {count is deep of iteration of the mandelbrot set. If |z| >=2 then z is not a member of a mandelset}. While (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do. Begin. Tmp := z1; Z1 := z1 * z1 - z2 * z2 + c1; Z2 := 2 * tmp * z2 + c2; Inc(Count); End; //the color-palette depends on TColor(n*count mod t). {$IFDEF LINUX}. ACanvas.Pen.Color := (16 * Count mod 255); ACanvas.DrawPoint(j, i); {$ELSE}. ACanvas.Pixels[j, i] := (16 * Count mod 255); {$ENDIF}. C1 := c1 + X; End; C2 := c2 + Y; End; End; Procedure TForm1.Button1Click(Sender: TObject); Var. R: TRect; Au, ao: Integer; DX, dY, bo, bu: Double; Begin. // Initialize Mandelbrot. R.Left := 0; R.Right := 200; R.Top := 0; R.Bottom := 205; Ao := 1; Au := -2; Bo := 1.5; Bu := -1.5; //direct scaling cause of speed. DX := (ao - au) / (R.Right - R.Left); DY := (bo - bu) / (R.Bottom - R.Top); DrawMandelbrot(Self.Canvas, dX, dY, au, bu, R.Right, R.Bottom); End;

Как инвертировать матрицу?

Code: Type. RCOMat = array of array of Extended; Var. DimMat: integer; Procedure InvertMatrix(var aa: RCOMat); Var. Numb, nula1, ipiv, indxr, indxc: array of Integer; I, j, l, kod, jmax, k, ll, icol, irow: Integer; Amax, d, c, pomos, big, dum, pivinv: Double; Ind: Boolean; Begin. For j := 0 to Pred(DimMat) do ipiv[j] := 0; Irow := 1; Icol := 1; For i := 0 to Pred(DimMat) do. Begin. Big := 0; For j := 0 to Pred(DimMat) do. Begin. If (ipiv[j] <> 1) then. Begin. For k := 0 to Pred(DimMat) do. Begin. If (ipiv[k] = 0) then. If (Abs(aa[j, k]) >= big) then. Begin. Big := Abs(aa[j, k]); Irow := j; Icol := k; End. Else; End; End; End; Ipiv[icol] := ipiv[icol] + 1; If (irow <> icol) then. Begin. For l := 0 to Pred(DimMat) do. Begin. Dum := aa[irow, l]; Aa[irow, l] := aa[icol, l]; Aa[icol, l] := dum; End; For l := 0 to Pred(DimMat) do. Begin. Dum := aa[irow + DimMat + 1, l]; Aa[irow + DimMat + 1, l] := aa[icol + DimMat + 1, l]; Aa[icol + DimMat + 1, l] := dum; End; End; Indxr[i] := irow; Indxc[i] := icol; If (aa[icol, icol] = 0) then; Pivinv := 1.0 / aa[icol, icol]; Aa[icol, icol] := 1.0; For l := 0 to Pred(DimMat) do aa[icol, l] := aa[icol, l] * pivinv; For l := 0 to Pred(DimMat) do aa[icol + DimMat + 1, l] := Aa[icol + DimMat + 1, l] * pivinv; For ll := 0 to Pred(DimMat) do. Begin. If (ll <> icol) then. Begin. Dum := aa[ll, icol]; Aa[ll, icol] := 0.0; For l := 0 to Pred(DimMat) do aa[ll, l] := aa[ll, l] - aa[icol, l] * dum; For l := 0 to Pred(DimMat) do aa[ll + DimMat + 1, l] := Aa[ll + DimMat + 1, l] - aa[icol + DimMat + 1, l] * dum; End; End; End; For l := Pred(DimMat) downto 0 do. Begin. If (indxr[l] <> indxc[l]) then. Begin. For k := 0 to Pred(DimMat) do. Begin. Dum := aa[k, indxr[l]]; Aa[k, indxr[l]] := aa[k, indxc[l]]; Aa[k, indxc[l]] := dum; End; End; End; End;

Как посчитать факториал?

Code: { The factorial of a positive integer is defined as: N! = n*(n-1)*(n-2)*(n-3)*...*2*1. 1! = 1. 0! = 1. Example: 5! = 5*4*3*2*1. } // Iterative Solution: Function FacIterative(n: Word): Longint; Var. F: LongInt; I: Integer; Begin. F := 1; For i := 2 to n do f := f * i; Result := f; End; // Recursive Solution: Function FacRecursive(n: Word): LongInt; Begin. If n > 1 then. Result := n * FacRecursive(n-1). Else. Result := 1; End;

Как проверить, является ли число простым?

Code: Function IsPrime(N: Cardinal): Boolean; register; // test if N is prime, do some small Strong Pseudo Prime test in certain bounds. // copyright (c) 2000 Hagen Reddmann, don't remove. Asm. TEST EAX,1 { Odd(N) ?? }. JNZ @@1. CMP EAX,2 { N == 2 ?? }. SETE AL. RET. @@1: CMP EAX,73 { N JB @@C }. JE @@E { N == 73 ?? }. PUSH ESI. PUSH EDI. PUSH EBX. PUSH EBP. PUSH EAX { save N as Param for @@5 }. LEA EBP,[EAX - 1] { M == N -1, Exponent }. MOV ECX,32 { calc remaining Bits of M and shift M' }. MOV ESI,EBP. @@2: DEC ECX. SHL ESI,1. JNC @@2. PUSH ECX { save Bits as Param for @@5 }. PUSH ESI { save M' as Param for @@5 }. CMP EAX,08A8D7Fh { N = 9080191 ?? }. JAE @@3. // now if (N MOV EAX,31. CALL @@5 { 31^((N-1)(2^s)) mod N }. JC @@4. MOV EAX,73 { 73^((N-1)(2^s)) mod N }. PUSH OFFSET @@4. JMP @@5. // now if (N @@3: MOV EAX,2. CALL @@5. JC @@4. MOV EAX,7. CALL @@5. JC @@4. MOV EAX,61. CALL @@5. @@4: SETNC AL. ADD ESP,4 * 3. POP EBP. POP EBX. POP EDI. POP ESI. RET. // do a Strong Pseudo Prime Test. @@5: MOV EBX,[ESP + 12] { N on stack }. MOV ECX,[ESP + 8] { remaining Bits }. MOV ESI,[ESP + 4] { M' }. MOV EDI,EAX { T = b, temp. Base }. @@6: DEC ECX. MUL EAX. DIV EBX. MOV EAX,EDX. SHL ESI,1. JNC @@7. MUL EDI. DIV EBX. AND ESI,ESI. MOV EAX,EDX. @@7: JNZ @@6. CMP EAX,1 { b^((N -1)(2^s)) mod N == 1 mod N ?? }. JE @@A. @@8: CMP EAX,EBP { b^((N -1)(2^s)) mod N == -1 mod N ?? , EBP = N -1 }. JE @@A. DEC ECX { second part to 2^s }. JNG @@9. MUL EAX. DIV EBX. CMP EDX,1. MOV EAX,EDX. JNE @@8. @@9: STC. @@A: RET. @@B: DB 3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71. @@C: MOV EDX,OFFSET @@B. MOV ECX,18. @@D: CMP AL,[EDX + ECX]. JE @@E. DEC ECX. JNL @@D. @@E: SETE AL. End; Procedure TForm1.Button1Click(Sender: TObject); Begin. If IsPrime(3453451) then. ShowMessage('yes'); End; {**** Another function ***}. Function IsPrime(Prim: Longint): Boolean; Var. Z: Real; Max: LongInt; Divisor: LongInt; Begin. Prime := False; If (Prim and 1) = 0 then Exit; Z := Sqrt(Prim); Max := Trunc(Z) + 1; Divisor := 3; While Max > Divisor do. Begin. If (Prim mod Divisor) = 0 then Exit; Inc(Divisor, 2); If (Prim mod Divisor) = 0 then Exit; Inc(Divisor, 4); End; Prime := True; End;

©Drkb::04086.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Способы редактирования данных.

Несмотря на декларированные недостатки технологии dbExpress — однонаправленные курсоры и невозможность редактирования — существуют программные способы уменьшить масштаб проблемы или даже решить ее.

Во-первых, в нашем распоряжении имеется компонент TSimpleDataSet, который реализует двунаправленный курсор и обеспечивает редактирование данных путем их кэширования на клиентской стороне.

Во-вторых, редактирование можно обеспечить настройкой и выполнением запросов SQL INSERT, UPDATE и DELETE.

У каждого способа есть свои преимущества и недостатки.

Компонент TSimpleDataSet безусловно хорош. Он технологичен, относительно прост в использовании и, главное, прячет всю функциональность за несколькими свойствами и методами. Но локальное кэширование изменений подходит далеко не для всех приложений.

Например, при многопользовательском интенсивном доступе к данным с их редактированием при локальном кэшировании могут возникнуть проблемы с целостностью и адекватностью данных. Самый распространенный пример: продавец в строительном супермаркете, обслуживая покупателя в пик летних ремонтов, резервирует несколько наименований ходовых товаров. Но покупатель замешкался, выбирая обои и плитку. А за это время другой продавец уже продал другому покупателю (заказ первого покупателя еще находится в локальном кэше!) часть его товаров.

Конечно, фиксацию изменений на сервере можно выполнять после локального сохранения каждой записи, но это приведет к загрузке соединения и снижению эффективности системы.

Использование модифицирующих запросов, с одной стороны, позволяет оперативно вносить изменения в данные на сервере, а с другой — требует больших затрат на программирование и отладку. Сложность кода в этом случае существенно выше.

Рассмотрим небольшой пример реализации обоих способов. Приложение Demo DBX использует соединение с сервером InterBase. Подключена тестовая база данных \Borland Shared\Data\MastSQL.gdb.

Пример приложения dbExpress с редактируемыми наборами данных.

Code: Implementation. {$R *.dfm}. Procedure TfmDemoDBX.FormCreate(Sender: TObj ect); Begin. TblVens.Open; CdsGusts.Open; End; Procedure TfmDemoDBX.FormDestroy(Sender: TObject); Begin. TblVens.Close; CdsCusts.Close; End; {Editing feature with updating query}. Procedure TfmDemoDBX.tblVensAfterScroll(DataSet: TDataSet); Begin. EdVenNo.Text := tblVens.FieldByName('VENDORNO').AsString; EdVenName.Text := tblVens.FieldByName('VENDORNAME').AsString; EdVenAdr.Text := tblVens.FieldByName('ADDRESS1')AsString; EdVenCity.Text := tblVens.FieldByName('CITY').AsString; EdVenPhone.Text := tblVens.FieldByName('PHONE').AsString; End; Procedure TfmDemoDBX.sbCancelClick(Sender: TObject); Begin. TblVens.First; End; Procedure TfmDemoDBX.sbNextClick(Sender: TObject); Begin. TblVens.Next; End; Procedure TfmDemoDBX.sbPostClick(Sender: TObject); Begin. With quUpdate do. Try. ParamByName('4dx').Aslnteger := TblVens.FieldByName('VENDORNO').Aslnteger; ParamByName('No').AsString := edVenNo.Text; ParamByName('Name').AsString := edVenName.Text; ParamByName('Adr').AsString := edVenAdr.Text; ParamByName('City').AsString := edVenCity.Text; ParamByName('Phone1').AsString := edVenPhone.Text; ExecSQL; Except. MessageDlg('Vendors info post error', mtError, [mbOK], 0); TblVens.First; End; End; {Editing feature with cached updates}. Procedure TfmDemoDBX.cdsCustsAfterPost(DataSet: TDataSet); Begin. CdsCusts.ApplyUpdates(-1); End; Procedure TfmDemoDBX.cdsCustsReconcileError(DataSet:TCustomClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); Begin. MessageDlg('Customers info post error', mtError, [mbOK], 0); CdsCusts.CancelUpdates; End; End.

Как перейти к нужному ключу в Regedit?

Code: Unit Unit1; Interface. Uses. Windows, Messages, Classes, Controls, Forms, StdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Procedure Button1Click(Sender: TObject); Procedure JumpToKey(Key: string); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Uses. ShellAPI; Procedure TForm1.JumpToKey(Key: string); Var. I, n: Integer; HWin: HWND; ExecInfo: ShellExecuteInfoA; Begin. HWin := FindWindowA(PChar('RegEdit_RegEdit'), nil); If hWin = 0 then. {if Regedit doesn't run then we launch it}. Begin. FillChar(ExecInfo, 60, #0); With ExecInfo do. Begin. CbSize := 60; FMask := SEE_MASK_NOCLOSEPROCESS; LpVerb := PChar('open'); LpFile := PChar('regedit.exe'); NShow := 1; End; ShellExecuteExA(@ExecInfo); WaitForInputIdle(ExecInfo.hProcess, 200); HWin := FindWindowA(PChar('RegEdit_RegEdit'), nil); End; ShowWindow(hWin, SW_SHOWNORMAL); HWin := FindWindowExA(hWin, 0, PChar('SysTreeView32'), nil); SetForegroundWindow(hWin); I := 30; Repeat. SendMessageA(hWin, WM_KEYDOWN, VK_LEFT, 0); Dec(i); Until i = 0; Sleep(500); SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0); Sleep(500); I := 1; N := Length(Key); Repeat. If Key[i] = '\' then. Begin. SendMessageA(hWin, WM_KEYDOWN, VK_RIGHT, 0); Sleep(500); End. Else. SendMessageA(hWin, WM_CHAR, Integer(Key[i]), 0); I := i + 1; Until i = n; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. JumpToKey('HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer'); End; End.

Как преобразовать указатель на метод в указатель на функцию?

Code: // Converting method pointers into function pointers. // Often you need a function pointer for a callback function. But what, if you want to specify a method as. // an callback? Converting a method pointer to a function pointer is not a trivial task; both types are. // incompatible with each other. Although you have the possibility to convert like this "@TClass.SomeMethod", // this is more a hack than a solution, because it restricts the use of this method to some kind of a class. // function, where you cannot access instance variables. If you fail to do so, you'll get a wonderful gpf. // But there is a better solution: run time code generation! Just allocate an executable memory block, and. // write 4 machine code instructions into it: 2 instructions loads the two pointers of the method pointer. // (code & data) into the registers, one calls the method via the code pointer, and the last is just a return. // Now you can use this pointer to the allocated memory as a plain function pointer, but in fact you are. // calling a method for a specific instance of a Class. Type TMyMethod = procedure of object; Function MakeProcInstance(M: TMethod): Pointer; Begin. // allocate memory. GetMem(Result, 15); Asm. // MOV ECX, MOV BYTE PTR [EAX], $B9. MOV ECX, M.Data. MOV DWORD PTR [EAX+$1], ECX. // POP EDX. MOV BYTE PTR [EAX+$5], $5A. // PUSH ECX. MOV BYTE PTR [EAX+$6], $51. // PUSH EDX. MOV BYTE PTR [EAX+$7], $52. // MOV ECX, MOV BYTE PTR [EAX+$8], $B9. MOV ECX, M.Code. MOV DWORD PTR [EAX+$9], ECX. // JMP ECX. MOV BYTE PTR [EAX+$D], $FF. MOV BYTE PTR [EAX+$E], $E1. End; End; Procedure FreeProcInstance(ProcInstance: Pointer); Begin. // free memory. FreeMem(ProcInstance, 15); End;

Заключение.

Если Вы зашли так далеко и поняли все то, о чем я говорил в этой статье - поздравляю Вас! Смотрите, я же говорил, что потоки в COM - это просто. Вы просто должны затратить немного времени, чтобы не спеша понять много нового, но в конце концов потоки они и есть потоки, это просто новое лицо, появляющееся при интеграции с COM. Я надеюсь, что Вы наслаждались чтением этой статьи так же, как я наслаждался написанием этой статьи (и потоковыми моделями).

На этом все. Скоро ждите еще много интересного!

Сайт автора и другие ресурсы по COM www.intac.com/~bly/com/index.htm.

©Drkb::04316.

Bitmap без формы.

Автор: Mike Scott.

Как мне загрузить изображение (BMP) и отобразить это на рабочем столе без использования формы? (Я хочу отображать это из DLL).

Существует один способ сделать это: создать холст TCanvas, получить контекст устройства для рабочего стола и назначить его дескриптору холста. После рисования на холсте десктоп отобразит ваше творение. Вот пример:

Code: Var. DesktopCanvas: TCanvas; Begin. DesktopCanvas := TCanvas.Create; Try. DesktopCanvas.Handle := GetDC(0); Try. DesktopCanvas.MoveTo(0, 0); DesktopCanvas.LineTo(Screen.Width, Screen.Height); Finally. ReleaseDC(0, DesktopCanvas.Handle); DesktopCanvas.Handle := 0; End; Finally. DesktopCanvas.Free; End; End;

Как копировать RTF текст в буфер обмена?

Code: { You have to dig into the Rich Text Format if you want to copy text to the. Clipboard that has format information embedded. The application you paste. This text into has to understand RTF, or the formatting will not show up. OK, the first step is to register a clipboard format for RTF, since this is. Not a predefined format: } Var. CF_RTF : Word; CF_RTF := RegisterClipboardFormat('Rich Text Format'); { The format name has to appear as typed above, this is the name used by MS. Word for Windows and similar MS products. NOTE: The Richedit Unit declares a constant CF_RTF, which is NOT the. Clipboard format handle but the string you need to pass to RegisterClipboard. Format! So you can place Richedit into your uses clause and change the line. Above to. } CF_RTF := RegisterClipboardFormat(Richedit.CF_RTF); { The next step is to build a RTF string with the embedded format information. You will get a shock if you inspect the mess of RTF stuff W4W will put into. The clipboard if you copy just a few characters (the app below allows you to. Inspect the clipboard), but you can get away with a lot less. The bare. Minimum would be something like this (inserts an underlined 44444): } Const. Testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}'; { The correct balance of opening and closing braces is extremely important, one. Mismatch and the target app will not be able to interpret the text. Correctly. If you want to control the font used for the pasted text you need. To add a fonttable (the default font is Tms Rmn, not the active font in the. Target app!). See example app below, testtext2. If you want more info, the. Full RTF specs can be found on www.microsoft.com, a subset is also described. In the Windows help compiler docs (hcw.hlp, comes with Delphi). } Unit Clipfmt1; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). MemFormats: TMemo; Label1: TLabel; BtnShowFormats: TButton; BtnGetRTF: TButton; BtnSetRTF: TButton; MemExample: TMemo; Procedure FormCreate(Sender: TObject); Procedure BtnShowFormatsClick(Sender: TObject); Procedure BtnGetRTFClick(Sender: TObject); Procedure BtnSetRTFClick(Sender: TObject); Private. Public. CF_RTF: Word; End; Var. Form1: TForm1; Implementation. Uses Clipbrd; {$R *.DFM}. Procedure TForm1.FormCreate(Sender: TObject); Begin. // register clipboard format rtf. CF_RTF := RegisterClipboardFormat('Rich Text Format'); If CF_RTF = 0 then. Begin. ShowMessage('Unable to register the Rich Text clipboard format!'); Application.Terminate; End; BtnShowFormats.Click; End; // show clipboard formats. Procedure TForm1.BtnShowFormatsClick(Sender: TObject); Var. Buf: array [0..60] of Char; N: Integer; Fmt: Word; Name: string[30]; Begin. MemFormats.Clear; For n := 0 to Clipboard.FormatCount - 1 do. Begin. Fmt := Clipboard.Formats[n]; If GetClipboardFormatName(fmt, buf, Pred(SizeOf(buf))) <> 0 then. MemFormats.Lines.Add(StrPas(buf)). Else. Begin. Case fmt of. 1: Name := 'CF_TEXT'; 2: Name := 'CF_BITMAP'; 3: Name := 'CF_METAFILEPICT'; 4: Name := 'CF_SYLK'; 5: Name := 'CF_DIF'; 6: Name := 'CF_TIFF'; 7: Name := 'CF_OEMTEXT'; 8: Name := 'CF_DIB'; 9: Name := 'CF_PALETTE'; 10: Name := 'CF_PENDATA'; 11: Name := 'CF_RIFF'; 12: Name := 'CF_WAVE'; 13: Name := 'CF_UNICODETEXT'; 14: Name := 'CF_ENHMETAFILE'; 15: Name := 'CF_HDROP (Win 95)'; 16: Name := 'CF_LOCALE (Win 95)'; 17: Name := 'CF_MAX (Win 95)'; $0080: Name := 'CF_OWNERDISPLAY'; $0081: Name := 'CF_DSPTEXT'; $0082: Name := 'CF_DSPBITMAP'; $0083: Name := 'CF_DSPMETAFILEPICT'; $008E: Name := 'CF_DSPENHMETAFILE'; $0200..$02FF: Name := 'private format'; $0300..$03FF: Name := 'GDI object'; Else. Name := 'unknown format'; End; MemFormats.Lines.Add(Name); End; End; End; // get rtf code from clipboard. Procedure TForm1.BtnGetRTFClick(Sender: TObject); Var. MemHandle: THandle; Begin. With Clipboard do. Begin. Open; Try. If HasFormat(CF_RTF) then. Begin. MemHandle := GetAsHandle(CF_RTF); MemExample.SetTextBuf(GlobalLock(MemHandle)); GlobalUnlock(MemHandle); End. Else. MessageDlg('The clipboard contains no RTF text!', MtError, [mbOK], 0); Finally. Close; End; End; End; // set rtf code to the clipboard. Procedure TForm1.BtnSetRTFClick(Sender: TObject); Const. Testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}'; Testtext2: PChar = '{\rtf1\ansi' + '\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman;}}' + '\pard\plain 12{\ul 44444}}'; Flap: Boolean = False; Var. MemHandle: THandle; Rtfstring: PChar; Begin. With Clipboard do. Begin. If flap then. Rtfstring := testtext2. Else. Rtfstring := testtext; Flap := not flap; MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1); If MemHandle <> 0 then. Begin. StrCopy(GlobalLock(MemHandle), rtfstring); GlobalUnlock(MemHandle); Open; Try. AsText := '1244444'; SetAsHandle(CF_RTF, MemHandle); Finally. Close; End; End. Else. MessageDlg('Global Alloc failed!', MtError, [mbOK], 0); End; End; End.

Blitting, Спрайты и Анимация.

Для тех, кто интересуется, что это за слово такое "JEDI"– выберите в Delphi 5 пункт меню Help->About и наберите слово JEDI, удерживая нажатой клавишу Alt. Вы узнаете, что JEDI – это аббревиатура, расшифровывающаяся как Join Endeavor of Delphi Innovators. (на русский это можно перевести приблизительно – Совместные Усилия Дельфийских Новаторов или еще лучше - все для Delphi, все для победы) :-).

Звучит красиво, но нам-то что до этого? На самом деле нам до этого есть дело – в рамках проекта JEDI (кстати, некоммерческого и держащегося на энтузиазме, пусть и с официальным одобрением Borland), в рамках именно этого проекта были созданы заголовочные файлы DirectX для Delphi. Так скачаем же их! (http://www.delphi-jedi.org/DelphiGraphics/).

Итак, заголовочные фалы у нас есть. Более того – мы умеем инициализировать Direct Draw, создавать Surfасе'ы и загружать на них картинки. (Если Вы забыли как это делается – перечитайте первые две главы).

Наконец то мы приблизились к самому интересному. Спрайты. Анимация. Blitting.

Blitting -непереводимое на русский язык слово. Тоже кстати аббревиатура - bit block transfer – пересылка блоков бит. Благодаря этой пересылке, мы можем скопировать прямоугольную область из одной части Surfасе'а в другую или из одного Surfасе'а в другой. Такое копирование происходит пересылкой байт в видеопамяти, отсюда и название - bit block transfer. Да конечно, ничего удивительного в копировании прямоугольных участков Вы не видите – это можно и без DirectDraw сделать кучей способов… Стоп! Прежде чем Вы начнете перечислять эти способы – Blitting с использованием DirectDraw самый быстрый. Тем паче, что большинство современных видеоадаптеров поддерживают его на аппаратном уровне. Чувствуете, к чему я клоню? Стоит разобраться с Вlitting'ом внимательнее.

Итак, для копирования прямоугольных участков интерфейс IDirectDrawSurface имеет два метода: IDirectDrawSurface4::Blt и IDirectDrawSurface4::BltFast. Как видно из названия второй быстрее – с него и начнем.

Code: Function BltFast(dwX: DWORD; DwY: DWORD; LpDDSrcSurface: IDirectDrawSurface4; LpSrcRect: PRect; DwTrans: DWORD): HResult;

Соответствие типов С++ и Delphi.

C Data Type | Object Pascal | Description.

----------------------------------------------

LPSTR PAnsiChar; String >pointer.

LPCSTR PAnsiChar; String >pointer.

DWORD Integer; Whole numbers.

BOOL LongBool; Boolean values.

PBOOL ^BOOL; Pointer to a Boolean value.

Pbyte ^Byte; Pointer to a byte value.

PINT ^Integer; Pointer to an integer value.

Psingle ^Single; Pointer to a single (floating point) value.

PWORD ^Word; Pointer to a 16-bit value.

PDWORD ^DWORD; Pointer to a 32-bit value.

LPDWORD PDWORD; Pointer to a 32-bit value.

UCHAR Byte; 8-bit values (can represent characters).

PUCHAR ^Byte; Pointer to 8-bit values.

SHORT Smallint; 16-bit whole numbers.

UINT Integer; 32-bit whole numbers. Traditionally,

This was used to represent unsigned integers,

But Object Pascal does not have a true.

Unsigned integer data type.

PUINT ^UINT; Pointer to 32-bit whole numbers.

ULONG Longint; 32-bit whole numbers. Traditionally,

This was used to represent unsigned integers,

But Object Pascal does not have a true.

Unsigned integer data type.

PULONG ^ULONG; Pointer to 32-bit whole numbers.

PLongint ^Longint; Pointer to 32-bit values.

PInteger ^Integer; Pointer to 32-bit values.

PSmallInt ^Smallint; Pointer to 16-bit values.

PDouble ^Double; Pointer to double (floating point) values.

LCID DWORD; A local identifier.

LANGID Word; A language identifier.

THandle Integer; An object handle. Many Windows API functions return a value.

Of type THandle, which identobject ifies that object within.

Windows'internal object tracking tables.

PHandle ^THandle; A pointer to a handle.

WPARAM Longint; A 32-bit message parameter. Under earlier versions of Windows,

This was a 16-bit data type.

LPARAM Longint; A 32-bit message parameter.

LRESULT Longint; A 32-bit function return value.

HWND Integer; A handle to a window. All windowed controls, child windows,

Main windows, etc., have a corresponding window handle that.

Identifies them within Windows'internal tracking tables.

HHOOK Integer; A handle to an installed Windows system hook.

ATOM Word; An index into the local or global atom table for a string.

HGLOBAL THandle; A handle identifying a globally allocated dynamic memory object.

Under 32-bit Windows, there is no distinction between globally.

And locally allocated memory.

HLOCAL THandle; A handle identifying a locally allocated dynamic memory object.

Under 32-bit Windows, there is no distinction between globally.

And locally allocated memory.

FARPROC Pointer; A pointer to a procedure, usually used as a parameter type in.

Functions that require a callback function.

HGDIOBJ Integer; A handle to a GDI object. Pens, device contexts, brushes, etc.,

All have a handle of this type that identifies them within.

Windows'internal tracking tables.

HBITMAP Integer; A handle to a Windows bitmap object.

HBRUSH Integer; A handle to a Windows brush object.

HDC Integer; A handle to a device context.

HENHMETAFILE Integer; A handle to a Windows enhanced metafile object.

HFONT Integer; A handle to a Windows logical font object.

HICON Integer; A handle to a Windows icon object.

HMENU Integer; A handle to a Windows menu object.

HMETAFILE Integer; A handle to a Windows metafile object.

HINST Integer; A handle to an instance object.

HMODULE HINST; A handle to a module.

HPALETTE Integer; A handle to a Windows color palette.

HPEN Integer; A handle to a Windows pen object.

HRGN Integer; A handle to a Windows region object.

HRSRC Integer; A handle to a Windows resource object.

HKL Integer; A handle to a keyboard layout.

HFILE Integer; A handle to an open file.

HCURSOR HICON; A handle to a Windows mouse cursor object.

COLORREF DWORD; A Windows color reference value, containing values.

For the red, green, and of ;bsp;blue components of a color.

©Drkb::00296.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Как локализовать (русифицировать) ресурсы какого-либо пакета (runtime package)?

1) Вынимаете ресурсы из этого модуля.

2) Переводите их на другой язык. (например русский).

3) Создаете в Delphi свой проект Dll-ки (с именем того модуля, из которого вы.

Вынули ресурсы, например vcl30), в который включаете _переведенные_

Ресурсы:

{$R vcl30rus.res}.

4) Собираете все это.

5) Переименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.

Если вы хотите, приложение "говорило" по русски только тогда, когда в.

Региональных установках стоит Russia - то тогда это все.

Если же вы хотите, чтобы ваше приложение _всегда_ поднимало русские ресурсы,

То необходимо сделать следующее добавление в Registry:

HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales.

"X:\MyProject\MyApp.exe" = "rus".

Теперь, когда ваше приложение будет поднимать pakages, то всегда будут браться.

Русские ресурсы. Другие приложения, например Delphi - это не затронет.

Таким образом можно заменять даже DFM-ки из проекта.

Более подробно об этом - см Help - Index - Localizing...

Alexander Simonenko .alex@protec.kiev.ua.(2:463/249).

©Drkb::04555.

Отображения величин в Watch List.

В BP 7.0 возможно было регулировать форму отображения величин.

В процессе отладки в окне ""Watch List"". Возможно ли такое в Delphi?

Такой эффект можно достичь используя следующие спецификации формата отображения (практически совпадающие с BP 7.0), которые указываются через запятую после идентификатора инспектируемой величины:

Символ Применяется к типу Функциональность.

-------- ------------------------------------------------------------------

H или X Integers Отображает целые величины в 16-ричном формате.

С префиксом 0x.

C Char,strings Показывает специальные символы (ASCII 0..31).

По умолчанию они отображаются в виде.

Esc-последовательности (/n , /t , и т.п.).

D Integers Отображает целые величины в десятичном формате.

Fn Floating point Показывает n десятичных знаков.

(где n = 2..18, по умолчанию 7 ).

NM All Дамп памяти, где n задает количество отображаемых.

Байт памяти, начиная с адреса величины.

По умолчанию каждый байт представляется двумя.

16-ричными цифрами, но возможно также совместное.

Использование nM с другими форматами.

P Pointers Отображает величину, как указатель в формате seg:ofs.

R Records, classes, Показывает не только величины полей,

Objects но и сами поля, напрмер, как (X:2; Y:5).

Вместо (2, 5).

S Char,strings Показывает любые неотображаемые ASCII символы в виде #nn.

Используется вместе с nM.

©Drkb::00053.

Автор: StayAtHome.

Взято с Vingrad.ru http://forum.vingrad.ru.

Таблицы строк.

Таблицы строк.

Ресурсы в виде таблиц строк (Stringtable) являются очень полезным подспорьем, когда ваше приложение должно хранить большое количество строк для их вывода во время выполнения приложения. Вы должны побороть искушение непосредственной вставки строк в вашу программу, поскольку использование таблиц строк имеет два неоспоримых преимущества:

1) Строки, хранимые в ресурсах, не занимают память до тех пор, пока они не будут загружены вашим приложением.

2) Stringtables легко редактировать, создавая таким образом локализованные (переведенные) версии вашего приложения.

Таблицы строк компилируются в ".res"-файл, который включается в exe-файл приложения во время сборки. Даже после того, как вы распространите ваше приложение, таблицы строк, содержащиеся в вашем приложении могут редактироваться редактором ресурсов. Моим любимым редактором ресурсов является Borland Resource Workshop, поставляемый в комплекте с Delphi. Он позволяет в режиме WYSIWYG редактировать как 16-, так и 32-битные ресурсы, как автономные, так и имплантированные в exe или dll-файлы. Тем более это удобно, если учесть что вместе со всеми версиями Delphi поставляется компилятор.

Ресурсов из командной строки (Borland Resource Command Line Compiler) (BRCC.EXE и BRCC32.EXE), расположенный в Delphi-директории Bin.

В нашем примере мы создадим интернациональное приложение, отображающее всего две кнопки. Кнопки будут иметь заголовки "Да" и "Нет", имеющие представления для английского, испанского и шведского языков.

Если вы вознамерились создавать мультиязыковые приложения с помощью Delphi, вам просто необходимо взглянуть на другие продукты фирмы Borland - Delphi Translation Suite и Language Pack software. Данные продукты позволяют изменять язык приложения одним щелчком!

Пример: Для начала в каталоге с исходным кодом приложения мы должны создать текстовый файл, содержащий строковые ресурсы. Пока вы можете создать файл с любым именем (главное, чтобы он имел расширение ".rc") и файл без разширения - главное, чтобы их имя не совпадало с именами файлов модулей и.

Файла проекта. Это очень важно, поскольку Delphi автоматически создает множество файлов с ресурсами для вашего приложения с теми же именами и переписывает их, не заботясь о наличии таких же файлов, но созданных вашими руками.

Вот содержание .rc-файла для нашего примера. Файл содержит слова "Yes" и "No" на английском, испанском и шведских языках:

STRINGTABLE.

{

1, "&Yes".

2, "&No".

17, "&Si".

18, "&No".

33, "&Ja".

34, "&Nej".

}

Файл начинается с ключевого слова stringtable, обозначая, что следом располагается таблица строк. Сами строки находятся внутри скобок, таким образом таблица должна быть обрамлена двумя скобками -

Открывающей и закрывающей. Каждая строка должна содержать идентификатор, сопровождаемый строкой,

Заключенной в кавычки. Строка может содержать вплоть до 255 символов. Если вам нужно вставить.

Нестандартный символ, напишите его восьмиричный код и предварите его обратной косой чертой.

Единственное исключение - когда вам нужно вставить саму обратную черту - в этом случае понадобиться.

Использование двух таких символов. Вот два примера:

1, "A two\012line string".

2, "c:\\Borland\\Delphi".

Используемый номер индекса абсолютно не важен для компилятора. Вы должны иметь в виду, что таблицы.

Строк располагаются в памяти в 16 битных сегментах (Win 3.xx).

Для компиляции .rc-файла в .res-файл, который можно прилинковать к вашему приложению, вы должны.

Набрать в командной строке полный путь к компилятору ресурсов и полный путь к компилируемому.

.rc-файлу. Вот пример:

C:\Delphi\Bin\brcc32.exe c:\Delphi\strtbl32.rc.

После окончания процесса компиляции в указанном каталоге появляется файл с тем же именем, что и у.

.rc-файла, но имеющий расширение ".res".

Для включения ресурсов в ваше приложение необходимо в коде программы добавить следующую директиву.

Компилятора, указывающую на файл с ресурсами:

{$R ResFileName.RES}.

После того, как .res-файл прилинкуется к приложению, вы можете воспользоваться связанными.

Ресурсами из любого модуля вашего проекта, даже если вы определили директиву $R в секции реализации.

(implementation) другого модуля.

Вот пример использования Windows API функции LoadString() для загрузки в массив символов третьей.

Строки из таблицы строк:

If LoadString(hInstance, 3, @a, sizeof(a)) <> 0 then ....

В этом примере функция LoadString() передает дескриптор (hInstance) модуля, содержащего ресурс,

Индекс требуемой строки, адрес массива символов, куда будет передана строка и размер самого массива.

Функция LoadString возвращает количество реально переданных символов без учета терминатора. Будьте.

Внимательны: при использовании UNICODE количество загружаемых байт будет другим.

Ниже приведен исчерпывающий пример создания многоязыкового приложения с помощью Delphi. Приложение.

Совместимо как с 16, так и с 32-битными версиями Delphi.

Для этого вам придется создать два идентичных .rc-файла, один для 16-битной версии, второй для.

32-битной, т.к. используемые ресурсы для каждой платформы свои. В данном примере мы создадим один.

Файл с именем STRTBL16.rc, а другой с именем STRTBL32.rc. Скомпилируйте файл STRTBL16.rc с помощью.

16-битного компилятора BRCC.exe (расположен в каталоге BIN Delphi 1) и файл STRTBL32.rc с помощью.

BRCC32.exe (расположен в той же директории 32-битной версии Delphi).

Во время работы приложения мы выясняем язык операционной системы, установленный по умолчанию.

Метод получения такой информации отличается для 16- и 32-битной версии Windows. Чтобы сделать код.

Более читабельным, мы позаимствовали "языковые" константы из файла Windows.pas, применяемого в.

32-битной версии Delphi.

Code: {$IFDEF WIN32}. {$R STRTBL32.RES}. {$ELSE}. {$R STRTBL16.RES}. Const LANG_ENGLISH = $09; Const LANG_SPANISH = $0a; Const LANG_SWEDISH = $1d; {$ENDIF}. Function GetLanguage : word; {$IFDEF WIN32}. {$ELSE}. Var. S : string; I : integer; {$ENDIF}. Begin. {$IFDEF WIN32}. GetLanguage := GetUserDefaultLangID and $3ff; {$ELSE}. S[0] := Char(GetProfileString('intl', 'sLanguage', 'none', @s[1], sizeof(s)-2)); For i := 1 to length(s) do. S[i] := UpCase(s[i]); If s = 'ENU' then GetLanguage := LANG_ENGLISH else. If s = 'ESN' then GetLanguage := LANG_SPANISH else. If s = 'SVE' then GetLanguage := LANG_SWEDISH else. GetLanguage := LANG_ENGLISH; {$ENDIF}. End; Procedure TForm1.FormCreate(Sender: TObject); Var. A : array[0..255] of char; StrTblOfs : integer; Begin. {Получаем текущий язык системы и начало соответствующих строк в таблице}. Case GetLanguage of. LANG_ENGLISH : StrTblOfs := 0; LANG_SPANISH : StrTblOfs := 16; LANG_SWEDISH : StrTblOfs := 32; Else. StrTblOfs := 0; End; {Загружаем и устанавливаем заголовок кнопки "Yes" в соответствии с языком}. If LoadString(hInstance, StrTblOfs + 1, @a, sizeof(a)) <> 0 then. Button1.Caption := StrPas(a); {Загружаем и устанавливаем заголовок кнопки "No" в соответствии с языком}. If LoadString(hInstance, StrTblOfs + 2, @a, sizeof(a)) <> 0 then. Button2.Caption := StrPas(a); End;

Универсальные пароли к BIOS.

AWARD BIOS v2.50.

AWARD_SW.

J262.

TTPTHA.

01322222.

KDD.

ZBAAACA.

APAf.

Lkwpeter.

T0ch88.

T0ch20x.

H6BB.

J09F.

TzqF.

AWARD BIOS v2.51.

AWARD_WG.

J256.

BIOSTAR.

HLT.

ZAAADA.

Syxz.

?award.

256256.

Alfarome.

SWITCHES_SW.

Sxyz.

SZYX.

T0ch20x.

AWARD BIOS v2.51G.

G6PJ.

J322.

ZJAAADC.

Wodj.

Bios*

Biosstar.

H6BB.

HELGA-S.

HEWITT.

RAND.

HLT.

T0ch88.

Zjaaadc.

AWARD BIOS v2.51U.

1EAAh.

Condo.

Biostar.

CONDO.

CONCAT.

Djonet.

Efmukl.

G6PJ.

J09F.

J64.

Zbaaaca.

AWARD BIOS v4.5x.

AWARD_SW.

AWARD_PW.

589589.

PASSWORD.

SKY_FOX.

AWARD SW.

Award.sw.

AWARD?SW.

Award_?

Award_ps.

ZAAADA.

AMI BIOS.

AMI.

AMI_SW (не универсальный но устанавливается при сбросе CMOS/SETUP'a).

SER.

Ctrl+Alt+Del+Ins (держать при загрузке, иногда просто INS) ;).

A.M.I.

Aammii.

Ami.kez.

Ami°

Amiami.

AMI!SW.

AMI.KEY.

AMI?SW.

AMISETUP.

AMI~

AMIPSWD.

Amipswd.

Hе1gаЯs.

Bios310.

Amidecod.

BIOSPASS.

CMOSPWD.

HEWITT RAND.

KILLCMOS.

AMPTON BIOS.

Polrty.

AST BIOS.

SnuFG5.

BIOSTAR BIOS.

Biostar.

Q54arwms.

COMPAQ BIOS.

Compaq.

CONCORD BIOS.

Last.

CTX International BIOS.

CTX_123.

CyberMax BIOS.

Congress.

Daewoo BIOS.

Daewuu.

Daytek BIOS.

Daytec.

DELL BIOS.

Dell.

Digital Equipment BIOS.

Komprie.

Enox BIOS.

Xo11nE.

Epox BIOS.

Central.

Freetech BIOS.

Posterie.

HP Vectra BIOS.

Hewlpack.

IBM BIOS.

IBM.

MBIUO.

Sertafu.

Iwill BIOS.

Iwill.

JetWay BIOS.

Spoom1.

Joss Technology BIOS.

57gbz6.

Technolgi.

M Technology BIOS.

MMmM.

MachSpeed BIOS.

Sp99dd.

Magic-Pro BIOS.

Prost.

Megastar BIOS.

Star.

Megastar BIOS.

Sldkj754.

Xyzall.

Micronics BIOS.

Dn_04rjc.

Nimble BIOS.

Xdfk9874t3.

Packard Bell BIOS.

Bell9.

QDI BIOS.

QDI.

Quantex BIOS.

TeX1.

Xljlbj.

Research BIOS.

Col2ogro2.

Shuttle BIOS.

Col2ogro2.

Siemens Nixdorf BIOS.

SKY_FOX.

SpeedEasy BIOS.

Lesarot1.

SuperMicro BIOS.

Ksdjfg934t.

Tinys BIOS.

Tiny.

TMC BIOS.

BIGO.

Toshiba BIOS.

Toshiba.

24Banc81.

Toshy99.

Vextrec Technology BIOS.

Vextrex.

Vobis BIOS.

Merlin.

WIMBIOSnbsp v2.10 BIOS.

Compleri.

Zenith BIOS.

3098z.

Zenith.

ZEOS BIOS.

Zeosx.

[C] Faraon.

Источник: http://wasm.ru.

©Drkb::01366.

Автор: p0s0l.

Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?

Создайте процедуру, которая будет вызываться при событии Application.OnIdle.

Обьявим процедуру:

Code: {©Drkb v.3(2007): www.drkb.ru}. {Private declarations}. Procedure IdleEventHandler(Sender: TObject; var Done: Boolean); В разделе implementation опишем поцедуру: Procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean); Begin. {Do a small bit of work here}. Done := false; End;

Как отловить смену фокуса для всех контролов?

Code: Procedure TForm1.ActiveControlChange(Sender: TObject); {©Drkb v.3(2007): www.drkb.ru}. Begin. Caption := TScreen(Sender).ActiveForm.ActiveControl.Name; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. Screen.OnActiveControlChange := ActiveControlChange; End;

Как проверить правильность номера кредитной карточки?

Code: {------------------------------------------------- Returns: 0 : Card is invalid or unknown. 1 : Card is a valid AmEx. 2 : Card is a valid Visa. 3 : Card is a valid MasterCard. Ergebnis: 0 : Unbekannte Karte. 1 : AmEx Karte. 2 : Visa Karte. 3 : MasterCard Karte. -------------------------------------------------} Function CheckCC(c: string): Integer; Var. Card: string[21]; Vcard: array[0..21] of Byte absolute card; Xcard: Integer; Cstr: string[21]; Y, x: Integer; Begin. Cstr := ''; FillChar(Vcard, 22, #0); Card := c; For x := 1 to 20 do. If (Vcard[x] in [48..57]) then. Cstr := Cstr + chr(Vcard[x]); Card := ''; Card := Cstr; Xcard := 0; If not odd(Length(card)) then. For x := (Length(card) - 1) downto 1 do. Begin. If odd(x) then. Y := ((Vcard[x] - 48) * 2). Else. Y := (Vcard[x] - 48); If (y >= 10) then. Y := ((y - 10) + 1); Xcard := (Xcard + y). End. Else. For x := (Length(card) - 1) downto 1 do. Begin. If odd(x) then. Y := (Vcard[x] - 48). Else. Y := ((Vcard[x] - 48) * 2); If (y >= 10) then. Y := ((y - 10) + 1); Xcard := (Xcard + y). End; X := (10 - (Xcard mod 10)); If (x = 10) then. X := 0; If (x = (Vcard[Length(card)] - 48)) then. Result := Ord(Cstr[1]) - Ord('2'). Else. Result := 0. End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Case CheckCC(Edit1.Text) of. 0: Label1.Caption := 'Card is invalid or unknown'; 1: Label1.Caption := 'Card is a valid AmEx'; 2: Label1.Caption := 'Card is a valid Visa'; 3: Label1.Caption := 'Card is a valid MasterCard'; End; End;

©Drkb::04044.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Code: Unit Creditc; {***************************************************************************** Модуль Delphi для проверки номера кредитной карты. Версия: 1.1. Дата: Декабрь 20, 1996. Данный модуль создан на основе алгоритма ccard автора Peter Miller. Автор не против бесплатного использования, но резервирует все права. На данный алгоритм. Авторское право 1996 Shawn Wilson Harvell ( shawn@inet.net ). Применение: Внесите данный модуль в список uses любого модуля, которому. Необходим доступ к функции проверки кредитной карты. IsValidCreditCardNumber( CardNumber, ReturnMessage ) returns Boolean. Например, используйте это для уведомления пользователя о недействительности карты. CardNumber - строка, содержащая номер карты, которую необходимо проверить. ReturnMessage - строка, с помощью которой функция может возвратить любое сообщение. ( при этом старое содержимое строки стирается ). Возвращает true если номер карточки верен, false - в противном случае. Во входных параметрах функции допускаются тире и пробелы, Если же возможно присутствие других символов, вы можете их удалить. Функция RemoveChar довольно легко позаботится об этом, просто. Передайте ей входную строку и символ, который вы хотите удалить. Пользователь может свободно изменять код модуля для собственных целей, Но в случае его распространения он должен сообщить пользователям. Обо всех внесенных изменениях. Используйте модуль на свой страх и риск, поскольку он свободен от явных. И неявных гарантий. Ответственность за какой-либо ущерб, причиненный. Данным модулем лежит на его пользователе. На момент написания модуля он устойчиво работал под Delphi версий 1 и 2, Для Turbo Pascal необходимо внести некоторые несложные исправления (главным. Образом из-за различия реализации функций в модуле SysUtils). Если вы нашли этот модуль полезным, имеете какие-то пожелания или предложения, Отправьте автору письмо по адресу электронной почты shawn@inet.net. История изменений. Версия 1.1 -- Декабрь 20, 1996. Исправлена ошибка с Discover card: соответственно увеличина длина маски "database". Версия 1.0 -- Октябрь 26, 1996. Первый выпуск. *****************************************************************************} Interface. Uses SysUtils; Function IsValidCreditCardNumber(CardNumber: string; var MessageText: string): Boolean; Implementation. Const. CardPrefixes: array[1..19] of string = ('2014', '2149', '300', '301', '302', '303', '304', '305', '34', '36', '37', '38', '4', '51', '52', '53', '54', '55', '6011'); CardTypes: array[1..19] of string = ('enRoute', 'enRoute', 'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche', 'Diner Club/Carte Blanche', 'American Express', 'Diner Club/Carte Blanche', 'American Express', 'Diner Club/Carte Blanche', 'Visa', 'MasterCard', 'MasterCard', 'MasterCard', 'MasterCard', 'MasterCard', 'Discover'); Function RemoveChar(const Input: string; DeletedChar: Char): string; Var. Index: Word; { переменная счетчика }. Begin. { данная функция удаляет все вхождения указанного символа из переданной ей }. { строки }. Result := Input; For Index := Length(Result) downto 1 do. If Result[Index] = DeletedChar then. Delete(Result, Index, 1); End; Function ShiftMask(Input: Integer): Integer; Begin. { простая оболочка для функции сдвига битов числа }. Result := (1 shl (Input - 12)); End; Function ConfirmChecksum(CardNumber: string): Boolean; Var. CheckSum: Integer; { Содержит значение операции }. Flag: Boolean; { флаг готовности }. Counter: Integer; { индекс счетчика }. PartNumber: string; { используется для извлечения каждой цифры числа}. Number: Integer; { исп-ся для преобразования каждой цифры в число}. Begin. {************************************************************************** Это, вероятно, самая запутанный код, который вы когда-либо видели, я и сам. Запутался, когда работал над ним. Основное, что делает данная функция - Извлекает каждую цифру из номера карты для использования в формуле проверки. Контрольной суммы, устанавливаемую компаниями. Алгоритм производит выборку, Начиная от последней цифры и заканчивая первой. **************************************************************************} { получаем стартовое значение счетчика }. Counter := Length(CardNumber); CheckSum := 0; PartNumber := ''; Number := 0; Flag := false; While (Counter >= 1) do. Begin. { получаем текущую цифру }. PartNumber := Copy(CardNumber, Counter, 1); Number := StrToInt(PartNumber); { преобразуем в число }. If (Flag) then { только каждую вторую цифру }. Begin. Number := Number * 2; If (Number >= 10) then. Number := Number - 9; End; CheckSum := CheckSum + Number; Flag := not (Flag); Counter := Counter - 1; End; Result := ((CheckSum mod 10) = 0); End; Function GetMask(CardName: string): Integer; Begin. { значение по умолчанию }. Result := 0; If (CardName = 'MasterCard') then. Result := ShiftMask(16); If (CardName = 'Visa') then. Result := (ShiftMask(13) or ShiftMask(16)); If (CardName = 'American Express') then. Result := ShiftMask(15); If (CardName = 'Diner Club/Carte Blanche') then. Result := ShiftMask(14); If (CardName = 'Discover') then. Result := ShiftMask(16); End; Function IsValidCreditCardNumber(CardNumber: string; var MessageText: string): Boolean; Var. StrippedNumber: string; { используется для хранения числа без дополнительных символов }. Index: Integer; { универсальный счетчик для циклов и т.п. }. TheMask: Integer; { число, которое мы будем использовать для маски }. FoundIt: Boolean; { используется для индикации, когда что-либо найдено }. CardName: string; { хранит имя типа карты }. PerformChecksum: Boolean; { тип enRoute карты если контрольная сумма не сошлась }. Begin. { сначала избавимся от пробелов и тире }. StrippedNumber := RemoveChar(CardNumber, ' '); StrippedNumber := RemoveChar(StrippedNumber, '-'); { если строка была нулевой длины, то тоже OK }. If (StrippedNumber = '') then. Begin. Result := true; Exit; End; { инициализация возвращаемых переменных }. MessageText := ''; Result := true; { устанавливаем нашу переменную-флаг }. FoundIt := false; { проверка правильности введенных символов в номере карты }. For Index := 1 to Length(StrippedNumber) do. Begin. Case StrippedNumber[Index] of. '0'..'9': FoundIt := FoundIt; { другими словами не op }. Else. MessageText := 'Неверный введенный символ'; Result := false; Exit; End; End; { теперь давайте определим тип используемой карты }. For Index := 1 to 19 do. Begin. If (Pos(CardPrefixes[Index], StrippedNumber) = 1) then. Begin. { мы обнаружили правильный тип }. FoundIt := true; CardName := CardTypes[Index]; TheMask := GetMask(CardName); End; End; { если тип карты не определен, указываем на это }. If (not FoundIt) then. Begin. CardName := 'Unknown Card Type'; TheMask := 0; MessageText := 'Неизвестный тип карты '; Result := false; Exit; End; { проверка длины }. If ((Length(StrippedNumber) > 28) and result) then. Begin. MessageText := 'Номер слишком большой '; Result := false; Exit; End; { проверка длины }. If ((Length(StrippedNumber) < 12) or. ((shiftmask(length(strippednumber)) and themask) = 0)) then. Begin. Messagetext := 'неверная длина числа'; Result := false; Exit; End; { проверяем вычисление контрольной суммы }. If (cardname = 'enroute') then. Performchecksum := false. Else. Performchecksum := true; If (performchecksum and (not confirmchecksum(strippednumber))) then. Begin. Messagetext := 'неверная контрольная сумма'; Result := false; Exit; End; { если результат равен true, тогда все ok }. If (result) then. Messagetext := 'номер верен: тип карты: ' + cardname; { если строка была нулевой длины, то тоже OK }. If (strippednumber = '') then. Result := true; End; End.

©Drkb::04045.

Http://delphiworld.narod.ru/

DelphiWorld 6.0.

Читаем заголовок exe файла.

Code: { You'll need a OpenDialog to open a Exe-File and a Memo to show the file informations }. Procedure DumpDOSHeader(const h: IMAGE_DOS_HEADER; Lines: TStrings); Begin. Lines.Add('Dump of DOS file header'); Lines.Add(Format('Magic number: %d', [h.e_magic])); Lines.Add(Format('Bytes on last page of file: %d', [h.e_cblp])); Lines.Add(Format('Pages in file: %d', [h.e_cp])); Lines.Add(Format('Relocations: %d', [h.e_crlc])); Lines.Add(Format('Size of header in paragraphs: %d', [h.e_cparhdr])); Lines.Add(Format('Minimum extra paragraphs needed: %d', [h.e_minalloc])); Lines.Add(Format('Maximum extra paragraphs needed: %d', [h.e_maxalloc])); Lines.Add(Format('Initial (relative) SS value: %d', [h.e_ss])); Lines.Add(Format('Initial SP value: %d', [h.e_sp])); Lines.Add(Format('Checksum: %d', [h.e_csum])); Lines.Add(Format('Initial IP value: %d', [h.e_ip])); Lines.Add(Format('Initial (relative) CS value: %d', [h.e_cs])); Lines.Add(Format('File address of relocation table: %d', [h.e_lfarlc])); Lines.Add(Format('Overlay number: %d', [h.e_ovno])); Lines.Add(Format('OEM identifier (for e_oeminfo): %d', [h.e_oemid])); Lines.Add(Format('OEM information; e_oemid specific: %d', [h.e_oeminfo])); Lines.Add(Format('File address of new exe header: %d', [h._lfanew])); Lines.Add(''); End; Procedure DumpPEHeader(const h: IMAGE_FILE_HEADER; Lines: TStrings); Var. Dt: TDateTime; Begin. Lines.Add('Dump of PE file header'); Lines.Add(Format('Machine: %4x', [h.Machine])); Case h.Machine of. IMAGE_FILE_MACHINE_UNKNOWN : Lines.Add(' MACHINE_UNKNOWN '); IMAGE_FILE_MACHINE_I386: Lines.Add(' Intel 386. '); IMAGE_FILE_MACHINE_R3000: Lines.Add(' MIPS little-endian, 0x160 big-endian '); IMAGE_FILE_MACHINE_R4000: Lines.Add(' MIPS little-endian '); IMAGE_FILE_MACHINE_R10000: Lines.Add(' MIPS little-endian '); IMAGE_FILE_MACHINE_ALPHA: Lines.Add(' Alpha_AXP '); IMAGE_FILE_MACHINE_POWERPC: Lines.Add(' IBM PowerPC Little-Endian '); // some values no longer defined in winnt.h. $14D: Lines.Add(' Intel i860'); $268: Lines.Add(' Motorola 68000'); $290: Lines.Add(' PA RISC'); Else. Lines.Add(' unknown machine type'); End; { Case }. Lines.Add(Format('NumberOfSections: %d', [h.NumberOfSections])); Lines.Add(Format('TimeDateStamp: %d', [h.TimeDateStamp])); Dt := EncodeDate(1970, 1, 1) + h.Timedatestamp / SecsPerDay; Lines.Add(FormatDateTime(' c', dt)); Lines.Add(Format('PointerToSymbolTable: %d', [h.PointerToSymbolTable])); Lines.Add(Format('NumberOfSymbols: %d', [h.NumberOfSymbols])); Lines.Add(Format('SizeOfOptionalHeader: %d', [h.SizeOfOptionalHeader])); Lines.Add(Format('Characteristics: %d', [h.Characteristics])); If (IMAGE_FILE_DLL and h.Characteristics) <> 0 then. Lines.Add(' file is a DLL'). Else if (IMAGE_FILE_EXECUTABLE_IMAGE and h.Characteristics) <> 0 then. Lines.Add(' file is a program'); Lines.Add(''); End; Procedure DumpOptionalHeader(const h: IMAGE_OPTIONAL_HEADER; Lines: TStrings); Begin. Lines.Add('Dump of PE optional file header'); Lines.Add(Format('Magic: %d', [h.Magic])); Case h.Magic of. $107: Lines.Add(' ROM image'); $10b: Lines.Add(' executable image'); Else. Lines.Add(' unknown image type'); End; { If }. Lines.Add(Format('MajorLinkerVersion: %d', [h.MajorLinkerVersion])); Lines.Add(Format('MinorLinkerVersion: %d', [h.MinorLinkerVersion])); Lines.Add(Format('SizeOfCode: %d', [h.SizeOfCode])); Lines.Add(Format('SizeOfInitializedData: %d', [h.SizeOfInitializedData])); Lines.Add(Format('SizeOfUninitializedData: %d', [h.SizeOfUninitializedData])); Lines.Add(Format('AddressOfEntryPoint: %d', [h.AddressOfEntryPoint])); Lines.Add(Format('BaseOfCode: %d', [h.BaseOfCode])); Lines.Add(Format('BaseOfData: %d', [h.BaseOfData])); Lines.Add(Format('ImageBase: %d', [h.ImageBase])); Lines.Add(Format('SectionAlignment: %d', [h.SectionAlignment])); Lines.Add(Format('FileAlignment: %d', [h.FileAlignment])); Lines.Add(Format('MajorOperatingSystemVersion: %d', [h.MajorOperatingSystemVersion])); Lines.Add(Format('MinorOperatingSystemVersion: %d', [h.MinorOperatingSystemVersion])); Lines.Add(Format('MajorImageVersion: %d', [h.MajorImageVersion])); Lines.Add(Format('MinorImageVersion: %d', [h.MinorImageVersion])); Lines.Add(Format('MajorSubsystemVersion: %d', [h.MajorSubsystemVersion])); Lines.Add(Format('MinorSubsystemVersion: %d', [h.MinorSubsystemVersion])); Lines.Add(Format('Win32VersionValue: %d', [h.Win32VersionValue])); Lines.Add(Format('SizeOfImage: %d', [h.SizeOfImage])); Lines.Add(Format('SizeOfHeaders: %d', [h.SizeOfHeaders])); Lines.Add(Format('CheckSum: %d', [h.CheckSum])); Lines.Add(Format('Subsystem: %d', [h.Subsystem])); Case h.Subsystem of. IMAGE_SUBSYSTEM_NATIVE: Lines.Add(' Image doesnot require a subsystem. '); IMAGE_SUBSYSTEM_WINDOWS_GUI: Lines.Add(' Image runs in the Windows GUI subsystem. '); IMAGE_SUBSYSTEM_WINDOWS_CUI: Lines.Add(' Image runs in the Windows character subsystem. '); IMAGE_SUBSYSTEM_OS2_CUI: Lines.Add(' image runs in the OS/2 character subsystem. '); IMAGE_SUBSYSTEM_POSIX_CUI: Lines.Add(' image run in the Posix character subsystem. '); Else. Lines.Add(' unknown subsystem'). End; { Case }. Lines.Add(Format('DllCharacteristics: %d', [h.DllCharacteristics])); Lines.Add(Format('SizeOfStackReserve: %d', [h.SizeOfStackReserve])); Lines.Add(Format('SizeOfStackCommit: %d', [h.SizeOfStackCommit])); Lines.Add(Format('SizeOfHeapReserve: %d', [h.SizeOfHeapReserve])); Lines.Add(Format('SizeOfHeapCommit: %d', [h.SizeOfHeapCommit])); Lines.Add(Format('LoaderFlags: %d', [h.LoaderFlags])); Lines.Add(Format('NumberOfRvaAndSizes: %d', [h.NumberOfRvaAndSizes])); End; // Example Call, Beispielaufruf: Procedure TForm1.Button1Click(Sender: TObject); Var. Fs: TFilestream; Signature: DWORD; Dos_header: IMAGE_DOS_HEADER; Pe_header: IMAGE_FILE_HEADER; Opt_header: IMAGE_OPTIONAL_HEADER; Begin. Memo1.Clear; With Opendialog1 do. Begin. Filter := 'Executables (*.EXE)|*.EXE'; If Execute then. Begin. Fs := TFilestream.Create(FileName, fmOpenread or fmShareDenyNone); Try. Fs.read(dos_header, SizeOf(dos_header)); If dos_header.e_magic <> IMAGE_DOS_SIGNATURE then. Begin. Memo1.Lines.Add('Invalid DOS file header'); Exit; End; DumpDOSHeader(dos_header, memo1.Lines); Fs.seek(dos_header._lfanew, soFromBeginning); Fs.read(signature, SizeOf(signature)); If signature <> IMAGE_NT_SIGNATURE then. Begin. Memo1.Lines.Add('Invalid PE header'); Exit; End; Fs.read(pe_header, SizeOf(pe_header)); DumpPEHeader(pe_header, memo1.Lines); If pe_header.SizeOfOptionalHeader > 0 then. Begin. Fs.read(opt_header, SizeOf(opt_header)); DumpOptionalHeader(opt_header, memo1.Lines); End; Finally. Fs.Free; End; { finally }. End; End; End;

©Drkb::02108.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Как получить текст HTML Документа из TWebBrowser без тегов.

Code: Uses mshtml, activex; Procedure GetHtmlCode(WebBrowser: TWebBrowser; FileName: string); Var. HtmlDoc: IHtmlDocument2; PersistFile: IPersistFile; Begin. HtmlDoc := WebBrowser.document as IHtmlDocument2; PersistFile := HTMLDoc as IPersistFile; PersistFile.save(StringToOleStr(FileName), true); End;

Скопировать, удалить, вставить в TWebBrowser.

Code: Uses. ActiveX; // Copy the selected text to the clipboard. Procedure TForm1.Button7Click(Sender: TObject); Begin. Try. WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER); Except. End; End; // Cut the selected text. Procedure TForm1.Button8Click(Sender: TObject); Begin. Try. WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER); Except. End; End; // Delete the selected text. Procedure TForm1.Button9Click(Sender: TObject); Begin. Try. WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER); Except. End; End; Initialization. OleInitialize(nil); Finalization. OleUninitialize; End. // as of Internet Explorer 4.

Поиск в TreeView по тексту.

Code: // Search a TreeItem through its Text property. // Return value is a TreeNodeObject. Function Form1.TreeItemSearch(TV: TTreeView; SucheItem: string): TTreeNode; Var. I: Integer; IItem: string; Begin. If (TV = nil) or (SucheItem = '') then Exit; For i := 0 to TV.Items.Count - 1 do. Begin. IItem := TV.Items[i].Text; If SucheItem = iItem then. Begin. Result := TV.Items[i]; Exit; End. Else. Begin. Result := nil; End; End; End;

Example: Search for Wasserfall in TreeView1 and select item.

Code: Procedure TForm1.Button1Click(Sender: TObject); Var. Node: TTreeNode; Begin. //either - entweder so. Node := TreeItemSuchen(TreeView1, 'Wasserfall'); TreeView1.Selected := Node; //or - oder so. TreeView1.Selected := TreeItemSuchen(TreeView1, 'Wasserfall '); End;

©Drkb::00631.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Code: Function FindNode(Tree: TTreeView; Node: TTreeNode; S: String): TTreeNode; Var t:Integer; Begin. Result:=nil; { Если поиск идёт в корне }. IF not Assigned(Node) then. Begin. Node:=Tree.Items.GetFirstNode; While Assigned(Node) Do. Begin. IF Node.Text = S then. Begin. Result:=Node; Break; End; {IF}. Node:=Node.GetNextSibling; End; {While}. { или если в другой ветви }. End else For t:=0 to Node.Count - 1 Do IF Node[t].Text = S then. Begin. Result:=Node[t]; Break; End; {else}. End;

Взято из http://forum.sources.ru.

Автор: Song.

©Drkb::00632.

Автор: Peter Kane.

Как получить неповторяющиеся случайные числа?

Code: Procedure Shuffle(var aArray; aItemCount: Integer; aItemSize: Integer); { after Julian M Bucknall }. Var. Inx: Integer; RandInx: Integer; SwapItem: PByteArray; A: TByteArray absolute aArray; Begin. If (aItemCount > 1) then. Begin. GetMem(SwapItem, aItemSize); Try. For Inx := 0 to (aItemCount - 2) do. Begin. RandInx := Random(aItemCount - Inx); Move(A[Inx * aItemSize], SwapItem^, aItemSize); Move(A[RandInx * aItemSize], A[Inx * aItemSize], aItemSize); Move(SwapItem^, A[RandInx * aItemSize], aItemSize); End; Finally. FreeMem(SwapItem, aItemSize); End; End; End; Procedure TForm1.Button1Click(Sender: TObject); Var. A: array[1..10] of Integer; I: Shortint; Begin. Randomize; For i := Low(a) to High(a) do a[i] := i; Shuffle(a, High(a), SizeOf(Integer)); For i := 1 to High(a) - 1 do. ListBox1.Items.Add(IntToStr(a[i])); End;

Удаление и добавление значений динамического массива.

Code: Type. TArrayString = array of string; Procedure DeleteArrayIndex(var X: TArrayString; Index: Integer); Begin. If Index > High(X) then Exit; If Index < Low(X) then Exit; If Index = High(X) then. Begin. SetLength(X, Length(X) - 1); Exit; End; Finalize(X[Index]); System.Move(X[Index +1], X[Index], (Length(X) - Index -1) * SizeOf(string) + 1); SetLength(X, Length(X) - 1); End; // Example : Delete the second item from array a. // Beispiel : Losche das 2. Element vom array a. Procedure TForm1.Button2Click(Sender: TObject); Var. A: TArrayString; Begin. DeleteArrayIndex(a, 2); End;

Как закрыть help при закрытии приложения?

Code: Procedure TForm1.FormDestroy(Sender: TObject); Begin. Application.HelpCommand(HELP_QUIT, 0); End;

Как использовать CHM help в своём проекте?

Всё, что вам надо сделать, это сохранить ниже приведенный модуль на диске и добавить его в Uses вашего проекта. После этого Вы сможете использовать CHM файлы точно так же как и обычные HLP файлы.

Code: Unit StoHtmlHelp; //////////////////////////////////////////////////////////////// // Implementation of context sensitive HTML help (.chm) for Delphi. // // Version: 1.2. // Author: Martin Stoeckli. // Homepage: www.martinstoeckli.ch/delphi. // Copyright(c): Martin Stoeckli 2002. // // Restrictions: - Works only under the Windows platform. // - Is written for Delphi v7, should work from v6 up. // // Description. // *********** // This unit enables you to call ".chm" files from your Delphi projects. // You can use the normal Delphi VCL framework, write your projects the. // same way, as you would using normal ".hlp" files. // // Installation. // ************ // Simply add this unit to your project, that's all. // // If your help project contains files with the extension ".html". // instead of ".htm", then you can either pass the filename with the. // extension to Application.HelpJump(), or you can set the property. // "HtmlExt" of the global object in this unit. // StoHelpViewer.HtmlExt := '.html'; // // Examples. // ******** // // assign a helpfile, you could also select the helpfile at the. // // options dialog "Project/Options.../Application". // Application.HelpFile := 'C:\MyHelp.chm'; // ... // // shows the contents of the helpfile. // Application.HelpCommand(HELP_CONTENTS, 0); // // or. // Application.HelpSystem.ShowTableOfContents; // ... // // opens the context sensitive help with a numerical id. // // you could do the same by setting the "HelpContext". // // property of a component and pressing the F1 key. // Application.HelpContext(1000); // // or with a string constant. // Application.HelpJump('welcome'); // ... // // opens the help index with a keyword. // // you could do the same by setting the "HelpKeyword". // // property of a component and pressing the F1 key. // Application.HelpKeyword('how to do'); // Interface. Uses Classes, Windows, HelpIntfs; Type. THtmlHelpA = function(hwndCaller: HWND; pszFile: LPCSTR; uCommand: UINT; dwData: DWORD): HWND; stdcall; TStoHtmlHelpViewer = class(TInterfacedObject, ICustomHelpViewer, IExtendedHelpViewer, IHelpSelector). Private. FViewerID: Integer; FViewerName: String; FHtmlHelpFunction: THtmlHelpA; Protected. FHHCtrlHandle: THandle; FHelpManager: IHelpManager; FHtmlExt: String; Function GetHelpFileName: String; Function IsChmFile(const FileName: String): Boolean; Procedure InternalShutdown; Procedure CallHtmlHelp(const HelpFile: String; uCommand: UINT; dwData: DWORD); // ICustomHelpViewer. Function GetViewerName: String; Function UnderstandsKeyword(const HelpString: String): Integer; Function GetHelpStrings(const HelpString: String): TStringList; Function CanShowTableOfContents: Boolean; Procedure ShowTableOfContents; Procedure ShowHelp(const HelpString: String); Procedure NotifyID(const ViewerID: Integer); Procedure SoftShutDown; Procedure ShutDown; // IExtendedHelpViewer. Function UnderstandsTopic(const Topic: String): Boolean; Procedure DisplayTopic(const Topic: String); Function UnderstandsContext(const ContextID: Integer; Const HelpFileName: String): Boolean; Procedure DisplayHelpByContext(const ContextID: Integer; Const HelpFileName: String); // IHelpSelector. Function SelectKeyword(Keywords: TStrings) : Integer; Function TableOfContents(Contents: TStrings): Integer; Public. Constructor Create; virtual; Destructor Destroy; override; Property HtmlExt: String read FHtmlExt write FHtmlExt; End; Var. StoHelpViewer: TStoHtmlHelpViewer; Implementation. Uses Forms, SysUtils, WinHelpViewer; Const. // imported from HTML Help Workshop. HH_DISPLAY_TOPIC = $0000; HH_HELP_FINDER = $0000; // WinHelp equivalent. HH_DISPLAY_TOC = $0001; HH_DISPLAY_INDEX = $0002; HH_DISPLAY_SEARCH = $0003; HH_KEYWORD_LOOKUP = $000D; HH_DISPLAY_TEXT_POPUP = $000E; // display string resource id or text in a popup window. HH_HELP_CONTEXT = $000F; // display mapped numeric value in dwData. HH_TP_HELP_CONTEXTMENU = $0010; // text popup help, same as WinHelp HELP_CONTEXTMENU. HH_TP_HELP_WM_HELP = $0011; // text popup help, same as WinHelp HELP_WM_HELP. HH_CLOSE_ALL = $0012; // close all windows opened directly or indirectly by the caller. HH_ALINK_LOOKUP = $0013; // ALink version of HH_KEYWORD_LOOKUP. HH_GET_LAST_ERROR = $0014; // not currently implemented // See HHERROR.h. Type. TStoWinHelpTester = class(TInterfacedObject, IWinHelpTester). Protected. // IWinHelpTester. Function CanShowALink(const ALink, FileName: String): Boolean; Function CanShowTopic(const Topic, FileName: String): Boolean; Function CanShowContext(const Context: Integer; Const FileName: String): Boolean; Function GetHelpStrings(const ALink: String): TStringList; Function GetHelpPath : String; Function GetDefaultHelpFile: String; Function IsHlpFile(const FileName: String): Boolean; End; //////////////////////////////////////////////////////////////// // like "Application.ExeName", but in a DLL you get the name of. // the DLL instead of the application name. Function Sto_GetModuleName: String; Var. SzFileName: array[0..MAX_PATH] of Char; Begin. FillChar(szFileName, SizeOf(szFileName), #0); GetModuleFileName(hInstance, szFileName, MAX_PATH); Result := szFileName; End; //////////////////////////////////////////////////////////////// { TStoHtmlHelpViewer }. //////////////////////////////////////////////////////////////// Procedure TStoHtmlHelpViewer.CallHtmlHelp(const HelpFile: String; uCommand: UINT; dwData: DWORD); Begin. If Assigned(FHtmlHelpFunction) then. Begin. Case uCommand of. HH_CLOSE_ALL: FHtmlHelpFunction(0, nil, uCommand, dwData); // special parameters. HH_GET_LAST_ERROR: ; // ignore. Else. FHtmlHelpFunction(FHelpManager.GetHandle, PChar(HelpFile), uCommand, dwData); End; End; End; Function TStoHtmlHelpViewer.CanShowTableOfContents: Boolean; Begin. Result := True; End; Constructor TStoHtmlHelpViewer.Create; Begin. Inherited Create; FViewerName := 'StoHtmlHelp'; FHtmlExt := '.htm'; // load dll. FHHCtrlHandle := LoadLibrary('HHCtrl.ocx'); If (FHHCtrlHandle <> 0) then. FHtmlHelpFunction := GetProcAddress(FHHCtrlHandle, 'HtmlHelpA'); End; Destructor TStoHtmlHelpViewer.Destroy; Begin. StoHelpViewer := nil; // free dll. FHtmlHelpFunction := nil; If (FHHCtrlHandle <> 0) then. FreeLibrary(FHHCtrlHandle); Inherited Destroy; End; Procedure TStoHtmlHelpViewer.DisplayHelpByContext(const ContextID: Integer; Const HelpFileName: String); Var. SHelpFile: String; Begin. SHelpFile := GetHelpFileName; If IsChmFile(sHelpFile) then. CallHtmlHelp(sHelpFile, HH_HELP_CONTEXT, ContextID); End; Procedure TStoHtmlHelpViewer.DisplayTopic(const Topic: String); Var. SHelpFile: String; STopic: String; SFileExt: String; Begin. SHelpFile := GetHelpFileName; If IsChmFile(sHelpFile) then. Begin. // prepare topicname as a html page. STopic := Topic; SFileExt := LowerCase(ExtractFileExt(sTopic)); If (sFileExt <> '.htm') and (sFileExt <> '.html') then. STopic := sTopic + FHtmlExt; CallHtmlHelp(sHelpFile + '::/' + sTopic, HH_DISPLAY_TOPIC, 0); End; End; Function TStoHtmlHelpViewer.GetHelpFileName: String; Var. SPath: String; Begin. Result := ''; // ask for the helpfile name. If Assigned(FHelpManager) then. Result := FHelpManager.GetHelpFile; If (Result = '') then. Result := Application.CurrentHelpFile; // if no path is specified, then add the application path. // (otherwise the file won't be found if the current directory is wrong). If (Result <> '') then. Begin. SPath := ExtractFilePath(Result); If (sPath = '') then. Result := ExtractFilePath(Sto_GetModuleName) + Result; End; End; Function TStoHtmlHelpViewer.GetHelpStrings(const HelpString: String): TStringList; Begin. // create a tagged keyword. Result := TStringList.Create; Result.Add(Format('%s: %s', [FViewerName, HelpString])); End; Function TStoHtmlHelpViewer.GetViewerName: String; Begin. Result := FViewerName; End; Procedure TStoHtmlHelpViewer.InternalShutdown; Begin. If Assigned(FHelpManager) then. Begin. FHelpManager.Release(FViewerID); FHelpManager := nil; End; End; Function TStoHtmlHelpViewer.IsChmFile(const FileName: String): Boolean; Var. IPos: Integer; SFileExt: String; Begin. // find extension. IPos := LastDelimiter('.', FileName); If (iPos > 0) then. Begin. SFileExt := Copy(FileName, iPos, Length(FileName)); Result := CompareText(sFileExt, '.chm') = 0; End. Else. Result := False; End; Procedure TStoHtmlHelpViewer.NotifyID(const ViewerID: Integer); Begin. FViewerID := ViewerID; End; Function TStoHtmlHelpViewer.SelectKeyword(Keywords: TStrings): Integer; Var. I: Integer; SViewerName: String; Begin. Result := 0; I := 0; // find first tagged line (see GetHelpStrings). While (Result = 0) and (i <= Keywords.Count - 1) do. Begin. SViewerName := Keywords.Strings[i]; Delete(sViewerName, Pos(':', sViewerName), Length(sViewerName)); If (FViewerName = sViewerName) then. Result := i. Else. Inc(i); End; End; Procedure TStoHtmlHelpViewer.ShowHelp(const HelpString: String); Var. SHelpFile: String; SHelpString: String; Begin. SHelpFile := GetHelpFileName; If IsChmFile(sHelpFile) then. Begin. // remove the tag if necessary (see GetHelpStrings). SHelpString := HelpString; Delete(sHelpString, 1, Pos(':', sHelpString)); SHelpString := Trim(sHelpString); CallHtmlHelp(sHelpFile, HH_DISPLAY_INDEX, DWORD(Pchar(sHelpString))); End; End; Procedure TStoHtmlHelpViewer.ShowTableOfContents; Var. SHelpFile: String; Begin. SHelpFile := GetHelpFileName; If IsChmFile(sHelpFile) then. CallHtmlHelp(sHelpFile, HH_DISPLAY_TOC, 0); End; Procedure TStoHtmlHelpViewer.ShutDown; Begin. SoftShutDown; If Assigned(FHelpManager) then. FHelpManager := nil; End; Procedure TStoHtmlHelpViewer.SoftShutDown; Begin. CallHtmlHelp('', HH_CLOSE_ALL, 0); End; Function TStoHtmlHelpViewer.TableOfContents(Contents: TStrings): Integer; Begin. // find line with viewer name. Result := Contents.IndexOf(FViewerName); End; Function TStoHtmlHelpViewer.UnderstandsContext(const ContextID: Integer; Const HelpFileName: String): Boolean; Begin. Result := IsChmFile(HelpFileName); End; Function TStoHtmlHelpViewer.UnderstandsKeyword(const HelpString: String): Integer; Begin. If IsChmFile(GetHelpFileName) then. Result := 1. Else. Result := 0; End; Function TStoHtmlHelpViewer.UnderstandsTopic(const Topic: String): Boolean; Begin. Result := IsChmFile(GetHelpFileName); End; //////////////////////////////////////////////////////////////// { TStoWinHelpTester }. // // delphi will call the WinHelpTester to determine, if the default. // winhelp should handle the requests. // don't allow anything, because delphi (v7) will create an invalid. // helpfile path, calling GetHelpPath (it puts a pathdelimiter. // before the filename in "TWinHelpViewer.HelpFile"). //////////////////////////////////////////////////////////////// Function TStoWinHelpTester.CanShowALink(const ALink, FileName: String): Boolean; Begin. Result := False; // Result := IsHlpFile(FileName); End; Function TStoWinHelpTester.CanShowContext(const Context: Integer; Const FileName: String): Boolean; Begin. Result := False; // Result := IsHlpFile(FileName); End; Function TStoWinHelpTester.CanShowTopic(const Topic, FileName: String): Boolean; Begin. Result := False; // Result := IsHlpFile(FileName); End; Function TStoWinHelpTester.GetDefaultHelpFile: String; Begin. Result := ''; End; Function TStoWinHelpTester.GetHelpPath: String; Begin. Result := ''; End; Function TStoWinHelpTester.GetHelpStrings( Const ALink: String): TStringList; Begin. // as TWinHelpViewer would do it. Result := TStringList.Create; Result.Add(': ' + ALink); End; Function TStoWinHelpTester.IsHlpFile(const FileName: String): Boolean; Var. IPos: Integer; SFileExt: String; Begin. // file has extension '.hlp' ? IPos := LastDelimiter('.', FileName); If (iPos > 0) then. Begin. SFileExt := Copy(FileName, iPos, Length(FileName)); Result := CompareText(sFileExt, '.hlp') = 0; End. Else. Result := False; End; Initialization. StoHelpViewer := TStoHtmlHelpViewer.Create; RegisterViewer(StoHelpViewer, StoHelpViewer.FHelpManager); Application.HelpSystem.AssignHelpSelector(StoHelpViewer); WinHelpTester := TStoWinHelpTester.Create; Finalization. // do not free StoHelpViewer, because the object is referenced by the. // interface and will be freed automatically by releasing the last reference. If Assigned(StoHelpViewer) then. StoHelpViewer.InternalShutdown; End.

Как сделать WebBrowser средствами Delphi?

Автор: Лозовюк Александр.

WEB-сайт: http://search3i.al.ru/

Читая и перечитывая вопросы и ответы на Круглом столе сайта Королевство Дельфи я все время натыкался на вопросы о компоненте TWebBrowser. Сначала я думал, что все просто, но когда самому понадобилось написать приложение с использованием TwebBrowser… оказалось, что не все так просто!

Эта статья не претендует на исчерпывающие руководство по написанию браузера в Delphi 5 - скорее всего она будет со временем дополняться и исправляться. Я постарался обобщить в одном работающем примере решения большинства вопросов, заданных на этом сайте (признаюсь, там были и мои). Также выражаю большую признательность Елене Филлиповой за исчерпывающие ответы на некоторые из них, и всему Королевству за столь хороший и полезный сайт.

Компонент TWebBrowser в Delphi 4 нужно было специально инсталлировать как Active X компонент. В 5-й версии нам пошли навстречу, и он сразу есть на вкладке Internet. Не буду останавливаться на особенностях интерфейса программы - он очень прост (надеюсь, не очень) и не вызовет трудностей.

Рассмотрим некоторые свойства и функции TwebBrowser.

Procedure GoBack;

Procedure GoForward;

Procedure GoHome;

Procedure GoSearch;

Procedure Refresh;

Procedure Stop;

Procedure Quit;

Названия этих процедур говорят сами за себя, а позволяют они осуществить управление просмотром - перейти по истории просмотра вперед, назад, перейти на страницу, установленную как домашняя, открыть страницу поиска, обновить текущую страницу, остановить загрузку страницы, выйти.

Последняя команда самая интересная - в Help написано, что использовать ее не надо. Она завершает работу IE и очищает окно. Но я проверял - вроде вреда от ее использования не наблюдалось.

Далее идет целая группа процедур:

Procedure Navigate(const URL: WideString); overload;

Procedure Navigate(const URL: WideString; var Flags: OleVariant); overload;

Procedure Navigate(const URL: WideString; var Flags: OleVariant; var.

TargetFrameName: OleVariant); overload;

Procedure Navigate(const URL: WideString; var Flags: OleVariant;

Var TargetFrameName: OleVariant; var PostData: OleVariant); overload;

Procedure Navigate(const URL: WideString; var Flags: OleVariant;

Var TargetFrameName: OleVariant; var PostData: OleVariant;

Var Headers: OleVariant); overload;

Все они предназначены для указания того, какая и как страница должна отображаться в браузере. В простейшем случае можно использовать первую процедуру.

Procedure Navigate(const URL: WideString);

Например так:

WebBrowser1.Navigate(' http://delphi.vitpc.com/');

Или.

WebBrowser1.Navigate('http://delphi.vitpc.com/',empty,empty,empty,empty).

Для значения Flag определены такие константы:

NavOpenInNewWindow 1 Открывает URL в новом окне браузера.

NavNoHistory 2 Не заносит адрес в список History.

NavNoReadFromCache 4 Не использует сохраненную в кеше страницу, а загружает с сервера.

NavNoWriteToCache 8 Не записывает страницу в дисковый кеш.

NavAllowAutosearch 16 Если броузер не может найти указанный домен, он передает его в поисковый механизм.

Все, это можно также вручную установить в настройках браузера.

TargetFrameName указывает имя фрейма, куда надо загрузить страницу. Если присвоить NULL страница просто загрузиться в текущее окно.

PostData - указывает на данные, которые нужно отослать, используя метод HTTP POST. Если установить в NULL, процедура Navigate будет использовать метод HTTP GET.

Следующая довольно интересная и полезная процедура.

Procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); overload;

Позволяет осуществить управление браузером и вызывать различные дополнительные функции - печать, сохранение и др. Использует IoleCommandTarget интерфейс для управления браузером.

CmdID - задает команду, которую нужно выполнить. Может принимать следующие значения:

OLECMDID_OPEN,

OLECMDID_NEW,

OLECMDID_SAVE,

OLECMDID_SAVEAS,

OLECMDID_SAVECOPYAS,

OLECMDID_PRINT,

OLECMDID_PRINTPREVIEW,

OLECMDID_PAGESETUP,

OLECMDID_SPELL,

OLECMDID_PROPERTIES,

OLECMDID_CUT,

OLECMDID_COPY,

OLECMDID_PASTE,

OLECMDID_PASTESPECIAL,

OLECMDID_UNDO,

OLECMDID_REDO,

OLECMDID_SELECTALL,

OLECMDID_CLEARSELECTION,

OLECMDID_ZOOM,

OLECMDID_GETZOOMRANGE,

OLECMDID_UPDATECOMMANDS,

OLECMDID_REFRESH,

OLECMDID_STOP,

OLECMDID_HIDETOOLBARS,

OLECMDID_SETPROGRESSMAX ,

OLECMDID_SETPROGRESSPOS,

OLECMDID_SETPROGRESSTEXT,

OLECMDID_SETTITLE,

OLECMDID_SETDOWNLOADSTATE,

OLECMDID_STOPDOWNLOAD,

OLECMDID_FIND,

OLECMDID_ONTOOLBARACTIVATED,

OLECMDID_DELETE,

OLECMDID_HTTPEQUIV,

OLECMDID_ENABLE_INTERACTION,

OLECMDID_HTTPEQUIV_DONE,

OLECMDID_ONUNLOAD,

OLECMDID_PROPERTYBAG2,

OLECMDID_PREREFRESH.

Если присмотреться, то можно увидеть, что некоторые из них дублируються процедурами Stop, Refresh и др. Но большенство очень даже нужные.

Cmdexecopt - указывает дополнительно, как команда должна исполняться. Может принимать значения:

OLECMDEXECOPT_DODEFAULT 0 Команда исполняеться так, как принято по умолчанию.

OLECMDEXECOPT_PROMPTUSER 1 Перед выполнением выводиться окно диалога или дополнительных настроек.

OLECMDEXECOPT_DONTPROMPTUSER 2 Не задаеться никаких вопросов.

OLECMDEXECOPT_SHOWHELP 3 Выводиться справка по запрошеному действии, но сама команда не выполняеться. Удобно для вызова из вашего приложения справки по IE.

Вызивать эту комманду желательно и даже нужно в блоке.

Try.

WebBrowser1.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER);

Except.

End;

Эта команда вызивает диалоговое окно печати документа. Если же опустить try…except, то при нажатии "Отмена" в этом окне будет сгенерировано уведомление об ошибке типа:

Raised exception class EOleException with message "Невозможно установить свойство coISpan. Недопустимое значения свойства. Требуется ввести значение от 1 до 1000".

Теперь поговорим о свойствах.

PopupMenu; Как оконный элемент управления, TwebBrowser поддерживает всплывающие меню. НО! Ваше меню будет появляться только пока в браузер не загружена страница. Дальше - только меню IE.

В Конференции предложили такой вариант для запрета появления стандартного меню.

Code: ... Private. { Private declarations }. Procedure WMMouseActivate(var Msg: TMessage); message WM_MOUSEACTIVATE; Public. { Public declarations }. End; ... ... Procedure TForm1.WMMouseActivate(var Msg: TMessage); Begin. Try. Inherited; // right mouse button. If Msg.LParamHi = 516 then. Msg.Result:= MA_NOACTIVATEANDEAT; // insert code here for show own context menu. Except. End; End;

Перехватить WM_CONTEXTMENU в TWebBrowser.

Перехват меню (ТОЛЬКО БЛОКИРОВКА):

Code: Var. HookID: THandle; Function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall; Var. SzClassName: array[0..255] of Char; Const. Ie_name = 'Internet Explorer_Server'; Begin. Case nCode < 0 of. True: Result := CallNextHookEx(HookID, nCode, wParam, lParam). Else. Case wParam of. WM_RBUTTONDOWN, WM_RBUTTONUP: Begin. GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName)); If lstrcmp(@szClassName[0], @ie_name[1]) = 0 then. Result := HC_SKIP. Else. Result := CallNextHookEx(HookID, nCode, wParam, lParam); End. Else. Result := CallNextHookEx(HookID, nCode, wParam, lParam); End; End; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId()); End; Procedure TForm1.FormDestroy(Sender: TObject); Begin. If HookID <> 0 then. UnHookWindowsHookEx(HookID); End;

GIF для HTML в EXE.

Есть программа на Delphi, которая отображает какой-то html. В html используется gif-файл. Как в Delphi-проекте указать, чтобы этот gif находился в exe как некий кусок кода. А когда надо будет, записать его обратно в gif-файл без изменений, выковырнув из exe?

Можно, используя RxLib. После его установки в меню View появится пунктик Project Resources. Нужно выбрать Project Resources->New->User Data и добавить нужный файл. В данном случае ресурс был назван "RCDATA_1".

Если RxLib нет, то нужно создать файл описания ресурсов:

Code: === Begin gifs.rc === Mygif rcdata "имя_gif-файла.gif". Mygif1 rcdata "RCDATA_1". === End dots.rc ===

Показать код HTML страницы в TMemo.

Code: // You need a TMemo, a TButton and a NMHTTP. Procedure TForm1.Button1Click(Sender: TObject); Begin. NMHTTP1.Get('www.swissdelphicenter.ch'); Memo1.Text := NMHTTP1.Body. End;

Как получить цвет строки в HTML формате.

Если Вам необходимо создать HTML-файл, то необходимо объявить тэг для цвета шрифта либо цвета фона. Однако просто вставить значение TColor не получится - необходимо преобразовать цвет в формат RGB. В своём наборе SMExport я использую следующую функцию:

Code: Function GetHTMLColor(cl: TColor; IsBackColor: Boolean): string; Var. RgbColor: TColorRef; Begin. If IsBackColor then. Result := 'bg' Else. Result := ''; RgbColor := ColorToRGB(cl); Result := Result + 'color="#' + Format('%.2x%.2x%.2x', [GetRValue(rgbColor), GetGValue(rgbColor), GetBValue(rgbColor)]) + '"'; End;

Компонента HTML - редактора.

Если у тебя стоит MS Internet Explorer 5, то считай, редактор у тебя в кармане ;-) Дело в том, что вместе с эксплорером идет DHTML -- ActiveX контрол, представляющий собой редактор HTML-ок, покруче, чем FrontPage Express даже, т.к. держит даже стили (.css). Лежит в C:\Program Files\Common Files\Microsoft Shared\Triedit. В Дельфи устанавливается через меню Components|Import ActiveX Control. При распространении своей программы с этим компонентом не забудь, что помимо копирования на машину клиента всех файлов из приведенного выше каталога нужно, чтоб они зарегистрированы были (regsvr32 имяфайла).

©Drkb::03539.

Взято с http://delphiworld.narod.ru.

Hook функций в собственном приложении.

Code: Type. TSaveRedir = packed record. Addr: Pointer; Bytes: array[0..4] of Byte; End; PSaveRedir = ^TSaveRedir; Procedure RedirectCall(FromAddr, ToAddr: Pointer; SaveRedir: PSaveRedir); Var. OldProtect: Cardinal; NewCode: packed record. JMP: Byte; Distance: Integer; End; Begin. If not VirtualProtect(FromAddr, 5, PAGE_EXECUTE_READWRITE, OldProtect) then. RaiseLastWin32Error; If Assigned(SaveRedir) then. Begin. SaveRedir^.Addr := FromAddr; Move(FromAddr^, SaveRedir^.Bytes, 5); End; NewCode.JMP := $E9; NewCode.Distance := PChar(ToAddr) - PChar(FromAddr) - 5; Move(NewCode, FromAddr^, 5); If not VirtualProtect(FromAddr, 5, OldProtect, OldProtect) then. RaiseLastWin32Error; End; Procedure UndoRedirectCall(const SaveRedir: TSaveRedir); Var. OldProtect: Cardinal; Begin. If not VirtualProtect(SaveRedir.Addr, 5, PAGE_EXECUTE_READWRITE, OldProtect) then. RaiseLastWin32Error; Move(SaveRedir.Bytes, SaveRedir.Addr^, 5); If not VirtualProtect(SaveRedir.Addr, 5, OldProtect, OldProtect) then. RaiseLastWin32Error; End; // Example: Replace Application.MessageBox with your own. Function MyNewMessageBox(Self: TApplication; const Text, Caption: PChar; Flags: Longint): Integer; Begin. ShowMessage('New Messagebox'); //.... End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Application.MessageBox('You`ll never see this Text / Diesen Text wirst du nie sehen', '...', MB_OK); End; Var. S: TSaveRedir; Initialization. RedirectCall(@TApplication.MessageBox, @MyNewMessageBox, @S); Finalization. UndoRedirectCall(S);

Исследование E-Book Html Compiler 2.12.

Автор: Wersion.

WEB сайт: http://expwinprg.cjb.net/

Итак, как это было.

Достались мне замечательные туторы Iсzеliоn'а по ассемблеру на русском и английском языках. Перевод был сделан немного в стиле Рrоmt'а: с падежами, окончаниями и т.д. всё в порядке, а до смысла докопаться трудно. Я решил всё переделать и представить в культурном виде – в 'Single Exe' как обещают создатели E-Book Html Compiler 2.12. <-Закачал его с http://new-projects.com/booksoft/ (не ошибитесь версией) и запустил.

Что мы видим:

Функциональные ограничения (Нет вкладки Security вообще).

Nag в производимом файле.

Нехорошо. Начнём.

Что нужно: Tools (много):

ResHacker/Restorator/Exescope – обязательно.

Windows Commander 32 – обязательно.

UPX 1.07w – обязательно.

HIEW 6.11 – обязательно (Ну куда же нам без него!).

Turbo Pascal for Windows 7.1 – Recommended.

Ida Pro – optional.

TRW 2000 – optional.

Any File Analyzer – optional.

Procdump32 - optional.

The Customiser - Recommended.

W32Dasm – optional.

Brains: Среднее количество[x].

Исследование.

Посмотрим Help. Есть, оказывается, 3 версии:

This is the FREEWARE Version of the HTML Compiler. This FREEWARE version is for personal use only. You are required to purchase a license for any use that results in the exchange of money or goods by using this software.

Versions available. This version - Stand-Alone HTML Compiler PRO Compiles HTML text and images (including frames) into a single stand-alone executable.

Stand-Alone HTML Compiler PRO + enables the creation of shareware ebooks and button/menu text editing.

Попытаемся сделать из Freeware -> PRO+.

Откроем программу в ResHacker'e. Ясное дело, повреждены все ресурсы. Нельзя же без того, чтобы запаковать.Если хотите, можете посмотреть на файл сквозь ваш File Analyzer. Я засунул его в Procdump32->PE Editor. Ну, это наш старый знакомый UPX.

Как полагается его распаковывать:

Засунуть в Ida Pro. Найти инструкцию popad. Посмотреть куда направляется следующий jmp xxxxxxxxx. Записать xxxxxxxxx - ImageBase как Original Entry Point. Поставить в TRW 2000 брейкпоинт на адрес инструкции popad. Пройти её и следующий jmp xxxxxxxxxx по F10. Сделать Suspend. Сдампить. Выставить OEP. (не помню, он портит Import Table или нет, если да, то восстановите).

Воспользоваться самим Upx.

Проделать только в отладчике.

Я пробовал это. Только размер файла практически не увеличивается. И делает он такие нехорошие 'Single Exe',что быстро вешают систему. Автораспаковщики (e.g. GUW32) вообще производят неработоспособную бурду.

Что ж, я полез в Hiew 6.11 разбираться. Когда я указал ему пойти на адрес где-то в середине Ехе'шника, он крайне удивил меня сообщением 'Section out of File'. Пришлось дойти до конца секции. Посмотрите:

Как видите, после секции начинается что-то интересное. А именно новый Exe-file. (Последовательность байт MZP).Давайте напишем программу, которая вытащит нам его. Вот она:

Code: Program FileExtractor; Uses WinCrt; {Стандартные декларации}. Var i:longint; FileExe,FileDump:file of byte; RV:byte; Begin. Assign(FileExe,'htmlcomp.exe'); {$I-}. Reset(FileExe); {$I+}. If IOResult<>0 then {И}. Begin. Writeln('File not Found! Exiting...'); Readkey; DoneWinCrt; End; Assign(FileDump, 'Part2.exe'); {Процедуры}. Rewrite(FileDump); {Перейдём на FilePos=235520 =(39800 в шестнадцатиричной системе - см. выше}. Seek(FileExe,235520); For i:=FilePos(FileExe) to (FileSize(FileExe)-1) do. Begin. Read(FileExe,RV); {Ну и скатаем в другой файл}. Write(FileDump,RV); End; Close(FileExe); Close(FileDump); Writeln('Done.'); Readkey; DoneWinCrt; End.

CrtSock - модуль для работы с сокетами в Delphi32.

Автор: Paul Toth.

WEB-сайт: www.multimania.com/tothpaul.

CrtSock. Модуль для работы с сокетами.

Совместимость: Delphi 2+

Поддерживает TCP и UDP пакеты.

Не использует winsock.pas, поскольку обращается непосредственно к wsock32.dll.

Набор функций позволяет разрабатывать как клиентские, так и серверные приложения.

Перечень включенных в модуль функций:

Code: // Server side : // - start a server. // - wait for a client. Function StartServer(Port:word):integer; Function WaitClient(Server:integer):integer; Function WaitClientEx(Server:integer; var ip:string):integer; // Client side : // - call a server. Function CallServer(Server:string;Port:word):integer; // Both side : // - Assign CRT Sockets. // - Disconnect server. Procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile); Procedure Disconnect(Socket:integer); // BroadCasting (UDP). Function StartBroadCast(Port:word):integer; Function SendBroadCast(Server:integer; Port:word; s:string):integer; Function SendBroadCastTo(Server:integer; Port:word; Ip,s:string):integer; Function ReadBroadCast(Server:integer; Port:word):string; Function ReadBroadCastEx(Server:integer; Port:word; Var ip:string):string; // BlockRead. Function SockAvail(Socket:integer):integer; Function DataAvail(Var F:TextFile):integer; Function BlockReadsock(Var F:TextFile; Var s:string):boolean; Function send(socket:integer; Data:pointer; Datalen, Flags:integer):integer; stdcall; far; Function recv(socket:integer; Data:pchar; Datalen, Flags:integer):integer; stdcall; far;

Асинхронная ошибка.

Вопрос: Почему не работает следующий код?

Code: Begin. ClietnSocket1.Open; If ClietnSocket1.Socket.Connected then. ClietnSocket1.Socket.SendText('Hello'); {..} End; // Выдает - ассинхронная ошибка.

Таблицу в clipboard.

У меня есть 2 memo. как мне сделать так, чтобы в клипборд посылалосьтабличка из двух ячеек с содержимым их мемо. точнее как загнать табличку в клипборд программно.

Я смотрел, что когда копируешь из wогdа табличку, то в клипе лежит текст и картинка (вот с эти я больше всего не понял). Не понятно!!

Итак во-первых.

Мутим такую программку.

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Clipbrd, ComCtrls; Type. TForm1 = class(TForm). Memformats: TMemo; Memexample: TMemo; Label1: TLabel; BtnShowFormats: TButton; Btngetrtf: TButton; Btnsetrtf: TButton; RichEdit1: TRichEdit; Procedure FormCreate(Sender: TObject); Procedure BtnShowFormatsClick(Sender: TObject); Procedure btngetrtfClick(Sender: TObject); Procedure btnsetrtfClick(Sender: TObject); Private. { Private declarations }. Public. CF_RTF: Word; End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.FormCreate(Sender: TObject); Begin. // register clipboard format rtf. CF_RTF := RegisterClipboardFormat('Rich Text Format'); If CF_RTF = 0 then. Begin. ShowMessage('Unable to register the Rich Text clipboard format!'); Application.Terminate; End; BtnShowFormats.Click; End; Procedure TForm1.BtnShowFormatsClick(Sender: TObject); Var. Buf: array [0..60] of Char; N: Integer; Fmt: Word; Name: string[30]; Begin. MemFormats.Clear; For n := 0 to Clipboard.FormatCount - 1 do. Begin. Fmt := Clipboard.Formats[n]; If GetClipboardFormatName(fmt, buf, Pred(SizeOf(buf))) <> 0 then. MemFormats.Lines.Add(StrPas(buf)). Else. Begin. Case fmt of. 1: Name := 'CF_TEXT'; 2: Name := 'CF_BITMAP'; 3: Name := 'CF_METAFILEPICT'; 4: Name := 'CF_SYLK'; 5: Name := 'CF_DIF'; 6: Name := 'CF_TIFF'; 7: Name := 'CF_OEMTEXT'; 8: Name := 'CF_DIB'; 9: Name := 'CF_PALETTE'; 10: Name := 'CF_PENDATA'; 11: Name := 'CF_RIFF'; 12: Name := 'CF_WAVE'; 13: Name := 'CF_UNICODETEXT'; 14: Name := 'CF_ENHMETAFILE'; 15: Name := 'CF_HDROP (Win 95)'; 16: Name := 'CF_LOCALE (Win 95)'; 17: Name := 'CF_MAX (Win 95)'; $0080: Name := 'CF_OWNERDISPLAY'; $0081: Name := 'CF_DSPTEXT'; $0082: Name := 'CF_DSPBITMAP'; $0083: Name := 'CF_DSPMETAFILEPICT'; $008E: Name := 'CF_DSPENHMETAFILE'; $0200..$02FF: Name := 'private format'; $0300..$03FF: Name := 'GDI object'; Else. Name := 'unknown format'; End; MemFormats.Lines.Add(Name); End; End; End; Procedure TForm1.btngetrtfClick(Sender: TObject); Var. MemHandle: THandle; Begin. With Clipboard do. Begin. Open; Try. If HasFormat(CF_RTF) then. Begin. MemHandle := GetAsHandle(CF_RTF); MemExample.SetTextBuf(GlobalLock(MemHandle)); GlobalUnlock(MemHandle); End. Else. MessageDlg('The clipboard contains no RTF text!', MtError, [mbOK], 0); Finally. Close; End; End; End; Procedure TForm1.btnsetrtfClick(Sender: TObject); Const. Testtext: PChar = '{\rtf1\ansi\pard\plain 12{\ul 44444}}'; Testtext2: PChar = '{\rtf1\ansi' + '\deff4\deflang1033{\fonttbl{\f4\froman\fcharset0\fprq2 Times New Roman Cyr;}}' + '\pard\plain 12{\ul апопьтЧ}}'; Var. MemHandle: THandle; Rtfstring: PChar; Begin. With Clipboard do. Begin. Rtfstring :=memexample.Lines.GetText; // rtfstring :=testtext; MemHandle := GlobalAlloc(GHND or GMEM_SHARE, StrLen(rtfstring) + 1); If MemHandle <> 0 then. Begin. StrCopy(GlobalLock(MemHandle), rtfstring); GlobalUnlock(MemHandle); Open; Try. // AsText := '1244444'; SetAsHandle(CF_RTF, MemHandle); Finally. Close; End; End. Else. MessageDlg('Global Alloc failed!', MtError, [mbOK], 0); End; End; End.

Послать Alt + буква другому приложению.

Как мне программно нажать ALT + буква(VK_...) в другом приложении. Хендл я нашел, деляю так.

SendMessage(Handle_, WM_KEYDOWN, VK_MENU,0);

SendMessage(Handle_, WM_KEYDOWN, VK_F1,0);

SendMessage(Handle_, WM_KEYUP, VK_F1,0);

Но у меня не получается, что не так?

Попробуй так.

Code: SendMessage(Handle,WM_KEYDOWN,Byte(C),$20000001);

©Drkb::02116.

Взято из http://forum.sources.ru.

Проверка значения бита.

Проверка - установлен ли определенный бит?

Code: Function IsBitSet(Value: cardinal; BitNum : byte): boolean; {©Drkb v.3(2007): www.drkb.ru}. Begin. Result:=((Value shr BitNum) and 1) = 1. End; ... If IsBitSet(43691,1) then //установлен (равен 1).

Установка бита в единицу.

Установка бита в единицу.

Code: Function BitOn(const val: longint; const TheBit: byte): LongInt; {©Drkb v.3(2007): www.drkb.ru}. Begin. Result := val or (1 shl TheBit); End;

Установка бита в ноль.

Установка бита в ноль.

Code: Function BitOff(const val: longint; const TheBit: byte): LongInt; {©Drkb v.3(2007): www.drkb.ru}. Begin. Result := val and ((1 shl TheBit) xor $FFFFFFFF); End;

Как получить список всех зарегистрированных typelibs?

Code: Uses. Registry; Procedure EnumTypeLibs(TypeLibNames: TStrings); Var. F: TRegistry; KeyNames, keyVersions, keyInfos: TStringList; KeyName, keyVersion, keyInfo, tlName: string; I, j, k: Integer; Begin. TypeLibNames.Clear; KeyNames := nil; KeyVersions := nil; KeyInfos := nil; F := TRegistry.Create; Try. KeyNames := TStringList.Create; KeyVersions := TStringList.Create; KeyInfos := TStringList.Create; F.RootKey := HKEY_CLASSES_ROOT; If not f.OpenKey('TypeLib', False) then raise. Exception.Create('TRegistry.Open'); F.GetKeyNames(keyNames); F.CloseKey; For i := 0 to keyNames.Count - 1 do. Begin. KeyName := keyNames.Strings[i]; If not f.OpenKey(Format('TypeLib\%s', [keyName]), False) then Continue; F.GetKeyNames(keyVersions); F.CloseKey; For j := 0 to keyVersions.Count - 1 do. Begin. KeyVersion := keyVersions.Strings[j]; If not f.OpenKey(Format('TypeLib\%s\%s', [keyName, keyVersion]), False) then. Continue; TlName := f.ReadString(''); F.GetKeyNames(keyInfos); F.CloseKey; {$B-}. For k := 0 to keyInfos.Count - 1 do. Begin. KeyInfo := keyInfos.Strings[k]; If (keyInfo = '') or (keyInfo[1] < '0') or (keyInfo[1] > '9') then Continue; If not f.OpenKey(Format('TypeLib\%s\%s\%s\win32', [keyName, keyVersion, KeyInfo]), False) then Continue; F.CloseKey; TypeLibNames.Add(Format('%s ver.%s', [tlName, keyVersion])); End; {$B+}. End; End; Finally. F.Free; KeyNames.Free; KeyVersions.Free; KeyInfos.Free; End; End; // Example Call: Procedure TForm1.Button1Click(Sender: TObject); Begin. EnumTypeLibs(ListBox1.Items); End;

Переключение состояния бита с единицы на ноль и наоборот.

Переключение состояния бита с единицы на ноль и наоборот.

Code: Function BitToggle(const val: longint; const TheBit: byte): LongInt; {©Drkb v.3(2007): www.drkb.ru}. Begin. Result := val xor (1 shl TheeBit); End;

Избавление от скролов в MDI форме.

Code: { Избавление от SсrоllВаr'ов в MDI-форме. (С) Peter Below (TeamB) }. { Не надо VCL переписывать :-) }. Unit MainForm; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus; Type. TfMain = class(TForm). MainMenu1: TMainMenu; Newchild1: TMenuItem; Newchild2: TMenuItem; Procedure Newchild2Click(Sender: TObject); Procedure FormCreate(Sender: TObject); Private. { Private declarations }. Public. { Public declarations }. End; Var. FMain: TfMain; Implementation. Uses ChildForm; {$R *.DFM}. Procedure TfMain.Newchild2Click(Sender: TObject); Begin. With TfChild.Create(Application) do. Show(); End; Function ClientWindowProc( wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall; Var. F: Pointer; Begin. F := Pointer( GetWindowLong( wnd, GWL_USERDATA )); Case msg of. WM_NCCALCSIZE: If ( GetWindowLong( wnd, GWL_STYLE ) and. (WS_HSCROLL or WS_VSCROLL)) <> 0 then. SetWindowLong( wnd, GWL_STYLE, GetWindowLong( wnd, GWL_STYLE ). And not (WS_HSCROLL or WS_VSCROLL)); End; Result := CallWindowProc( f, wnd, msg, wparam, lparam ); End; Procedure TfMain.FormCreate(Sender: TObject); Begin. If ClientHandle <> 0 then begin. If GetWindowLong( ClientHandle, GWL_USERDATA ) <> 0 then. Exit; {cannot subclass client window, userdata already in use}. SetWindowLong(ClientHandle, GWL_USERDATA, SetWindowLong( ClientHandle, GWL_WNDPROC, integer( @ClientWindowProc))); End; End; End.

Пример чтения данных по битовой маске из значения.

Пример чтения данных по битовой маске из значения:

Code: Procedure TForm1.Button1Click(Sender: TObject); {©Drkb v.3(2007): www.drkb.ru}. Const. Col: Word = $ABCD; Var. R, G, B: Byte; Begin. R := Byte(Col shr 8) div 8; // первые 5 бит. G := ((Byte(Col shr 8) and $7) * 8) or (Byte(Col) div $20); // Вторые 6 бит. B := Byte(Col) and $1F; // третьи 5 бит. End;

Как узнать производителя CD/DVD?

Как это сделать через WMI я вроде разобрался.

Только не нравиться мне, что приходится перебирать в цикле все свойства.

Win32_CDROMDrive. Может кто знает как сразу к конкретному свойству обратиться, т.е.

Избавиться от строки "while PropEnum.Next(1, TempObj, Value) = S_OK do".

Вот рабочий пример для D7.

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, WbemScripting_TLB, OleServer, ActiveX, StdCtrls, ExtCtrls, ComCtrls; Type. TForm1 = class(TForm). ListBox1: TListBox; SWbemLocator1: TSWbemLocator; Button1: TButton; Procedure Button1Click(Sender: TObject); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.Button1Click(Sender: TObject); Var. Service: ISWbemServices; ObjectSet: ISWbemObjectSet; SObject: ISWbemObject; PropSet: ISWbemPropertySet; SProp: ISWbemProperty; PropEnum, Enum: IEnumVariant; TempObj: OleVariant; Value: Cardinal; Dr:string; Begin. ListBox1.Clear; Service:= SWbemLocator1.ConnectServer('.', 'root\CIMV2', '', '', '','', 0, nil); SObject:= Service.Get('Win32_CDROMDrive', wbemFlagUseAmendedQualifiers, nil); ObjectSet:= SObject.Instances_(0, nil); Enum:= (ObjectSet._NewEnum) as IEnumVariant; Dr:=''; While (Enum.Next(1, TempObj, Value) = S_OK) do. Begin. SObject:= IUnknown(TempObj) as SWBemObject; PropSet:= SObject.Properties_; PropEnum:= (PropSet._NewEnum) as IEnumVariant; While PropEnum.Next(1, TempObj, Value) = S_OK do. Begin. SProp:= IUnknown(TempObj) as SWBemProperty; If SProp.Name='Drive' then dr:=SProp.Get_Value; If SProp.Name='Name' then ListBox1.AddItem(dr+' '+SProp.Get_Value, nil); End; End; End; End.

Автор eralex.

©Drkb::01410.

Взято из http://forum.sources.ru.

Как открыть CD-ROM, если их несколько в системе?

Code: // DriveTools 1.0 * // (c) 1999 Jan Peter Stotz * // If you find bugs, has ideas for missing featurs, feel free to contact me * // jpstotz@gmx.de * // Date last modified: May 22, 1999 * Unit DriveTools; Interface. Uses. Windows, SysUtils, MMSystem; Function CloseCD(Drive: Char): Boolean; Function OpenCD(Drive: Char): Boolean; Implementation. Function OpenCD(Drive: Char): Boolean; Var. Res: MciError; OpenParm: TMCI_Open_Parms; Flags: DWord; S: string; DeviceID: Word; Begin. Result := false; S := Drive + ':'; Flags := mci_Open_Type or mci_Open_Element; With OpenParm do. Begin. DwCallback := 0; LpstrDeviceType := 'CDAudio'; LpstrElementName := PChar(S); End; Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm)); If Res <> 0 then. Exit; DeviceID := OpenParm.wDeviceID; Try. Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0); If Res = 0 then. Exit; Result := True; Finally. MciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm)); End; End; Function CloseCD(Drive: Char): Boolean; Var. Res: MciError; OpenParm: TMCI_Open_Parms; Flags: DWord; S: string; DeviceID: Word; Begin. Result := false; S := Drive + ':'; Flags := mci_Open_Type or mci_Open_Element; With OpenParm do. Begin. DwCallback := 0; LpstrDeviceType := 'CDAudio'; LpstrElementName := PChar(S); End; Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm)); If Res <> 0 then. Exit; DeviceID := OpenParm.wDeviceID; Try. Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); If Res = 0 then. Exit; Result := True; Finally. MciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm)); End; End; End.

©Drkb::01399.

Взято из http://forum.sources.ru.

Изменение скорости привода CD-ROM.

Находим в интернете файл ASPI.pas (еще есть wnaspi32.pas), подключаем его к проекту, пишем следующий код:

Code: Function SetCDSpeed(Host,Target:byte;Speed:integer):BOOL; {©Drkb v.3(2007): www.drkb.ru}. Var. DwASPIStatus: DWORD; HEvent: THandle; SrbExec: SRB_ExecSCSICmd; Begin. If Speed<176 then result:=false. Else. Begin. HEvent:=CreateEvent(nil, true, false, nil); Fillchar(srbExec,sizeof(SRB_ExecSCSICmd),0); SrbExec.SRB_Cmd:= SC_EXEC_SCSI_CMD; SrbExec.SRB_Flags:= SRB_DIR_OUT or SRB_EVENT_NOTIFY; SrbExec.SRB_Target:= Target; SrbExec.SRB_HaId:= Host; SrbExec.SRB_Lun:= 0; SrbExec.SRB_SenseLen:= SENSE_LEN; SrbExec.SRB_CDBLen:= 12; SrbExec.SRB_PostProc:=Pointer(hEvent); SrbExec.CDBByte[0]:= $BB; // команда изменения скорости привода. SrbExec.CDBByte[2]:= Speed shr 8; SrbExec.CDBByte[3]:= Speed; SrbExec.CDBByte[4]:= $FF; SrbExec.CDBByte[5]:= $FF; ResetEvent(hEvent); DwASPIStatus:= SendASPI32Command(@srbExec); If dwASPIStatus=SS_PENDING. Then. Begin. WaitForSingleObject(hEvent,INFINITE); End; If srbExec.SRB_Status<>SS_COMP. Then. Begin. MessageBox(0,'Error processing the SRB.','Error',MB_OK); Result:=false; End. Else. Result:=true; End; End;

Какие параметры передавать - написано в том же ASPI.pas.

Автор Rouse_

©Drkb::01411.

Взято из http://forum.sources.ru.

Как мне избавиться от выскакивающего окна CPU при ошибках?

HKEY_CURRENT_USER\Software\Borland\Delphi\4.0\Debugging.

ViewCPUOnException=0.

©Drkb::00055.

Взято с сайта http://www.delphifaq.com.

Получение имени шрифта, зная имя файла шрифта.

Function GetFontResourceInfoW (FontPath : PWideChar; var BufSize : DWORD; FontName : PWideChar; dwFlags : DWORD) : DWORD; stdcall; external 'GDI32.DLL';

1-ый параметр - указатель на Wide-строку, содержащую путь к файлу шрифта;

2-ой параметр - указатель на DWORD-переменную, содержащую размер выходного буфера. После выполнения функции в этой переменной будет содержаться необходимая длина буфера;

3-ий параметр - указатель на буфер, в случае успешного выполнения будет содержать Wide-строку имени шрифта;

4-ый параметр - какие-то флаги, если рыться в функции GetFontResourceInfoW особым случаем является когда dwFlags=4, но зачем это, я так и не понял - в результате будет возвращен тот же путь к файлу; ну а для получения имени шрифта флаг должен быть равен 1.

Code: Function GetFontName (FontFileA : PChar) : String; {©Drkb v.3(2007): www.drkb.ru}. Type. TGetFontResourceInfoW = function (FontPath : PWideChar; var BufSize : DWORD; FontName : PWideChar; dwFlags : DWORD) : DWORD; stdcall; Var. GetFontResourceInfoW : TGetFontResourceInfoW; FontFileW : PWideChar; FontNameW : PWideChar; FontFileWSize, FontNameSize : DWORD; Begin. Result := ''; GetFontResourceInfoW := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW'); If @GetFontResourceInfoW = nil then Exit; If AddFontResource(FontFileA) = 0 then Exit; FontFileWSize := (Length(FontFileA)+1)*2; GetMem(FontFileW, FontFileWSize); StringToWideChar(FontFileA, FontFileW, FontFileWSize); FontNameSize := 0; FontNameW := nil; GetFontResourceInfoW (FontFileW, FontNameSize, FontNameW, 1); GetMem (FontNameW, FontNameSize); FontNameW^ := #0; // на случай какого-нибудь облома. GetFontResourceInfoW (FontFileW, FontNameSize, FontNameW, 1); Result := FontNameW; FreeMem (FontFileW); FreeMem (FontNameW); RemoveFontResource(FontFileA); End;

Пример вызова:

GetFontName('C:\MyFonts\FUTURA.TTF') - возвратит 'FuturaEugenia'.

PS: Всё бы хорошо, но эта функция хоть и есть в Win9x, только её там вызывать нельзя - пишет "This function is only valid in Windows NT mode."...

FontView в Win9x использует EnumFontFamiliesEx (видимо по предложенному Vit'ом и x77 способу)...

FontView в WinNT использует GetFontResourceInfo (в импорте вообще нет EnumFontFamiliesEx или других Enum*)...

©Drkb::01930.

Автор: p0s0l.

Взято с Vingrad.ru http://forum.vingrad.ru.

Смена свойств приложения, открываемого, по умолчанию в среде при её запске.

Большинство стандартных темплейтов зашиты в delphide70.bpl (70 - версия), остальные - в каталоге Objrepos. Описаны же последние в файле bin\delphi32.dro. Т.о:

1. Добавляем в "delphi32.dro" строки:

[C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\MyApp].

Type=ProjectTemplate.

Page=Projects.

Name=My Application.

Description=This is my application template.

Author=Eugene.

Icon=C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\MyApp.ico.

DefaultProject=1.

Designer=dfm.

(для темплейтов формы Type=FormTemplate, DefaultMainForm=0/1, DefaultNewForm=0/1).

2. Размещаем нашу темплейт-прогу в каталоге "C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\" и называем её "MyApp.dpr".

3. Жмём "File/New/Application" (т.к. у нас DefaultProject=1), либо заходим во вкладку "Projects", а затем кликаем два раза по "My Application".

4. Радуемся!

©Drkb::00052.

Автор: Jin X.

Взято из http://forum.sources.ru.

ASCII код для PrintScreen.

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; Type. TForm1 = class(TForm). Procedure FormCreate(Sender: TObject); Private. { Private declarations }. Procedure AppIdle(Sender: TObject; var Done: Boolean); Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean); Begin. If GetAsyncKeyState(VK_SNAPSHOT) <> 0 then. Form1.Caption := 'PrintScreen ia?aoa !'; Done := True; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. Application.OnIdle := AppIdle; End; End.

©Drkb::01528.

Code: Type. TForm1 = class(TForm). Procedure FormCreate(Sender: TObject); Procedure FormDestroy(Sender: TObject); Private. { Private declarations }. Procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY; Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Const id_SnapShot = 101; Procedure TForm1.WMHotKey (var Msg : TWMHotKey); Begin. If Msg.HotKey = id_SnapShot then. ShowMessage('GotIt'); End; Procedure TForm1.FormCreate(Sender: TObject); Begin. RegisterHotKey(Form1.Handle, Id_SnapShot, 0, VK_SNAPSHOT); End; Procedure TForm1.FormDestroy(Sender: TObject); Begin. UnRegisterHotKey (Form1.Handle, id_SnapShot); End;

©Drkb::01529.

Взято из http://forum.sources.ru.

Если нажато более 2х клавиш одновременно...

Code: { I would like to detect more than 2 keys being pressed within a form. For example I would like to know if the user pressed time. The onkeydown seems to only check for one or two keys max but surely. You can determine what keys are currently down. } // You can use GetKeyState: Procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Begin. If ((GetKeyState(VK_CONTROL) AND 128)=128) and. ((GetKeyState(VK_F5) AND 128)=128) and. ((GetKeyState(ord('8')) AND 128)=128). Then. ShowMessage('CTRL+F5+8 Pressed'); End; ( Remember: Form1.Keypreview := TRUE ). // Or you can read the entire KeyBoard Status, // and later check for the three keys: Procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Var. KeybState: TKeyboardState; Begin. GetKeyboardState(Teclado); If ( (KeybState[VK_CONTROL] and 128)=128 ) and. ( (KeybState[VK_F5] and 128)=128 ) and. ( (KeybState[Ord('8')] and 128)=128 ). Then. ShowMessage('CTRL+F5+8 Pressed'); End;

©Drkb::01525.

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php.

Просмотр состояния корзины.

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI; Const. SHERB_NOCONFIRMATION = $1; SHERB_NOPROGRESSUI = $2; SHERB_NOSOUND = $4; Type. TForm1 = class(TForm). BtnGetRecicleBinFileCount: TButton; BtnEmptyRecicleBin: TButton; BtnDelToReciclebin: TButton; Procedure btnGetRecicleBinFileCountClick(Sender: TObject); Procedure btnEmptyRecicleBinClick(Sender: TObject); Procedure btnDelToReciclebinClick(Sender: TObject); End; Type. TSHQueryRBInfo = packed record. CbSize : DWORD; I64Size, I64NumItems : TLargeInteger; End; PSHQueryRBInfo = ^TSHQueryRBInfo; Function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar; DwFlags: DWORD): HRESULT; stdcall; External 'shell32.dll' name 'SHEmptyRecycleBinA'; Function SHQueryRecycleBin (pszRootPath: PChar; Var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall; External 'Shell32.dll' name 'SHQueryRecycleBinA'; Var. Form1: TForm1; Implementation. {$R *.dfm}. // Просмотр состояния корзины (краткая информация). Procedure TForm1.btnGetRecicleBinFileCountClick(Sender: TObject); Var. Info: TSHQueryRBInfo; Err: HRESULT; Begin. ZeroMemory(@Info, SizeOf(Info)); Info.cbSize := SizeOf(Info); Err := SHQueryRecycleBin(nil, Info); If Err = S_OK then. ShowMessage(Format('Всего в корзине %d эелементов, их общий размер: %d', [Info.i64NumItems, Info.i64Size])). Else. ShowMessage(SysErrorMessage(Err)); End; End.

Очистка корзины.

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI; Const. SHERB_NOCONFIRMATION = $1; SHERB_NOPROGRESSUI = $2; SHERB_NOSOUND = $4; Type. TForm1 = class(TForm). BtnGetRecicleBinFileCount: TButton; BtnEmptyRecicleBin: TButton; BtnDelToReciclebin: TButton; Procedure btnGetRecicleBinFileCountClick(Sender: TObject); Procedure btnEmptyRecicleBinClick(Sender: TObject); Procedure btnDelToReciclebinClick(Sender: TObject); End; Type. TSHQueryRBInfo = packed record. CbSize : DWORD; I64Size, I64NumItems : TLargeInteger; End; PSHQueryRBInfo = ^TSHQueryRBInfo; Function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar; DwFlags: DWORD): HRESULT; stdcall; External 'shell32.dll' name 'SHEmptyRecycleBinA'; Function SHQueryRecycleBin (pszRootPath: PChar; Var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall; External 'Shell32.dll' name 'SHQueryRecycleBinA'; Var. Form1: TForm1; Implementation. {$R *.dfm}. // Очистка корзины. Procedure TForm1.btnEmptyRecicleBinClick(Sender: TObject); Var. Err: HRESULT; Begin. Err := SHEmptyRecycleBin(Handle, 'c:\', SHERB_NOSOUND); If Err <> S_OK then ShowMessage(SysErrorMessage(Err)); End; End.

Удаление файла в корзину.

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI; Const. SHERB_NOCONFIRMATION = $1; SHERB_NOPROGRESSUI = $2; SHERB_NOSOUND = $4; Type. TForm1 = class(TForm). BtnGetRecicleBinFileCount: TButton; BtnEmptyRecicleBin: TButton; BtnDelToReciclebin: TButton; Procedure btnGetRecicleBinFileCountClick(Sender: TObject); Procedure btnEmptyRecicleBinClick(Sender: TObject); Procedure btnDelToReciclebinClick(Sender: TObject); End; Type. TSHQueryRBInfo = packed record. CbSize : DWORD; I64Size, I64NumItems : TLargeInteger; End; PSHQueryRBInfo = ^TSHQueryRBInfo; Function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar; DwFlags: DWORD): HRESULT; stdcall; External 'shell32.dll' name 'SHEmptyRecycleBinA'; Function SHQueryRecycleBin (pszRootPath: PChar; Var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall; External 'Shell32.dll' name 'SHQueryRecycleBinA'; Var. Form1: TForm1; Implementation. {$R *.dfm}. // Удаление файла в корзину... Procedure TForm1.btnDelToReciclebinClick(Sender: TObject); Var. Struct: TSHFileOpStruct; Err: HRESULT; Begin. With Struct do. Begin. Wnd := Handle; WFunc := FO_DELETE; PFrom := 'c:\1.txt'; PTo := nil; FFlags := FOF_ALLOWUNDO; FAnyOperationsAborted := True; HNameMappings := nil; LpszProgressTitle := nil; End; Err := SHFileOperation(Struct); If Err <> S_OK then ShowMessage(SysErrorMessage(Err)); End; End.

Получение информации о папках и файлах находящихся на данный момент в корзине.

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellAPI, ShlObj, ActiveX, ComCtrls, Menus; // корзина отображает не всю информацию по удаленному элементу. // а только 6 позиций. // в действительности этих позиций больше... Const. DETAIL_COUNT = 11; Type. TForm1 = class(TForm). Button1: TButton; ListView1: TListView; PopupMenu1: TPopupMenu; MnuRestore: TMenuItem; Procedure Button1Click(Sender: TObject); Procedure mnuRestoreClick(Sender: TObject); End; Var. Form1: TForm1; Implementation. {$R *.dfm}. // Функция взята из QDialogs... Function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag: String = ''): String; Var. P: PChar; Begin. Case StrRet.uType of. STRRET_CSTR: SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); STRRET_OFFSET: Begin. P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); End; STRRET_WSTR: If Assigned(StrRet.pOleStr) then. Result := StrRet.pOleStr. Else. Result := ''; End; { This is a hack bug fix to get around Windows Shell Controls returning. Spurious "?"s in date/time detail fields }. If (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then. Result := StringReplace(Result, '?', '', [rfReplaceAll]); End; // Смотрим содержимое корзины... Function ViewRecycleBin(const AHandle: THandle; LV: TListView): Boolean; Var. Ppidl, Item: PItemIDList; Desktop: IShellFolder; RecycleBin: IShellFolder2; RecycleBinEnum: IEnumIDList; Fetched, I: Cardinal; Details: TShellDetails; Mallok: IMalloc; TmpStr: ShortString; Begin. Result := False; If LV = nil then Exit; LV.Clear; LV.Columns.Clear; LV.ViewStyle := vsReport; If SHGetMalloc(Mallok) = S_OK then. If SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then. If SHGetDesktopFolder(Desktop) = S_OK then. If Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then. If RecycleBin.EnumObjects(AHandle, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS, RecycleBinEnum) = S_OK then. Begin. // Создаем колонки. For I := 0 to DETAIL_COUNT - 1 do. If RecycleBin.GetDetailsOf(nil, I, Details) = S_OK then. Try. With LV.Columns.Add do. Begin. Caption := StrRetToString(Item, Details.str); Width := LV.Canvas.TextWidth(Caption) + 24; End; Finally. Mallok.Free(Details.str.pOleStr); End; // Перечиляем содержимое корзины. While True do. Begin. RecycleBinEnum.Next(1, Item, Fetched); If Fetched = 0 then Break; If RecycleBin.GetDetailsOf(Item, 0, Details) = S_OK then. Begin. Try. TmpStr := StrRetToString(Item, Details.str); Finally. Mallok.Free(Details.str.pOleStr); End; With LV.Items.Add do. Begin. Caption := TmpStr; For I := 1 to DETAIL_COUNT - 1 do. If RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then. Try. SubItems.Add(StrRetToString(Item, Details.str)); Finally. Mallok.Free(Details.str.pOleStr); End; End; End; End; Result := True; End; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. ViewRecycleBin(Handle, ListView1); End; End.

Восстановление файла из корзины.

Code: {©Drkb v.3(2007): www.drkb.ru}. // Функция восстанавливает выбранный в ListView элемент из корзины... Function RestoreElement(const AHandle: THandle; LV: TListView): Boolean; Function GetLVItemText(const Index: Integer): String; Begin. If Index = 0 then. Result := LV.Selected.Caption. Else. Result := LV.Selected.SubItems.Strings[Index - 1]; End; Var. Ppidl, Item: PItemIDList; Desktop: IShellFolder; RecycleBin: IShellFolder2; RecycleBinEnum: IEnumIDList; Fetched, I: Cardinal; Details: TShellDetails; Mallok: IMalloc; Valid: Boolean; Context: IContextMenu; AInvokeCommand: TCMInvokeCommandInfo; Begin. Result := False; If LV = nil then Exit; If SHGetMalloc(Mallok) = S_OK then. If SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then. If SHGetDesktopFolder(Desktop) = S_OK then. If Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then. If RecycleBin.EnumObjects(AHandle, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, RecycleBinEnum) = S_OK then. Begin. // Перечиляем содержимое корзины. While True do. Begin. RecycleBinEnum.Next(1, Item, Fetched); If Fetched = 0 then Break; Valid := False; For I := 0 to DETAIL_COUNT - 1 do. If RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then. Try. // Ищем нужный нам элемент. Valid := GetLVItemText(I) = StrRetToString(Item, Details.str); If not Valid then Break; Finally. Mallok.Free(Details.str.pOleStr); End; // Если выделенный элемент найден. If Valid then. Begin. // Восстанавливаем его при помощи интерфейса IContextMenu. If RecycleBin.GetUIObjectOf(AHandle, 1, Item, IID_IContextMenu, nil, Pointer(Context)) = S_OK then. Begin. FillMemory(@AInvokeCommand, SizeOf(AInvokeCommand), 0); With AInvokeCommand do. Begin. CbSize := SizeOf(AInvokeCommand); Hwnd := AHandle; // - локализация не нужна... LpVerb := 'undelete'; // - восстановление фийла из корзины... //lpVerb := 'properties'; // - показ диалога свойства... //lpVerb := 'delete'; // - удаление файла из корзины... FMask := 0; LpDirectory := PChar(LV.Selected.SubItems.Strings[0]); NShow := SW_SHOWNORMAL; End; Result := Context.InvokeCommand(AInvokeCommand) = S_OK; Break; End; End; End; End; End; Procedure TForm1.mnuRestoreClick(Sender: TObject); Begin. If ListView1.Selected <> nil then. If RestoreElement(Handle, ListView1) then ShowMessage('Элемент успешно восстановлен.'); End;

Пример работы с корзиной можно скачать здесь:

Rbin.zip

Автор: Rouse_

©Drkb::01713.

Взято из http://forum.sources.ru.

Закрытие всех окон IE.

Code: Procedure CloseAllIE_1; Var. Ie:HWND; Begine. //Ищем окно IE. Ie:=FindWindow(`IEFrame`, nil); //пока найдено окно IE... While ie<>0 do. Begin. //... закрываем его. Postmessage (ie, WM_CLOSE, 0, 0); //ищем следующее. Ie:=FindWindow (`IEFrame`, nil); End; End;

Основы работы с Windows API.

Основы работы с Windows API.

Введение.

Цель этого обзора - помочь человеку перейти от использования средств Delphi к функциям Win API. Предполагается, что читатель уже неплохо владеет Delphi, поэтому будет подчёркиваться, прежде всего, разница между этими двумя инструментами. Кроме того, многие авторы книг по Delphi не уделяют достаточно внимания функциям Win API, предназначенным для работы с окнами и графикой, потому что считают, что VCL Delphi достаточно хорошо справляется с этими задачами. Так что часто приходится учиться работе с Win API по книгам по 16-разрядному Borland Раsсаl'ю. Поэтому я буду обращать внимание и на отличие 32-разрядных версий от 16-разрядных. Но я не буду без особой необходимости останавливаться на подробном описании конкретных функций, так как это всё сделано в справочной системе. Я также остановлюсь и на этой самой справочной системе, потому что начинающему программисту может оказаться не очень просто разобраться с ней.

Что такое Win API.

Win API - это набор функций, предоставляемых операционной системой каждой программе. Эти функции находятся в стандартных динамически компонуемых библиотеках (Dynamic Linked Library, DLL), таких как kernel32.dll, user32.dll, gdi32.dll. Эти файлы находятся в директории Window\System. Вообще говоря, каждая программа должна самостоятельно заботится о том, чтобы подключить эти библиотеки. DLL могут подключаться к программе статически и динамически. В первом случае программа <освобождает> DLL только при завершении, во втором освобождение может произойти в любой момент. Если после освобождения DLL оказывается, что её больше не использует ни одна программа, она выгружается из памяти. Так как стандартные библиотеки используются самой системой, они всегда находятся в памяти, и поэтому использование динамического подключения бессмысленно. Чтобы статически подключить в Delphi некоторую функцию Win API, например, функцию GetWindowDC из модуля user32.dll, надо написать конструкцию вида.

Function GetWindowDC(Wnd: HWnd); HDC; stdcall; external 'user32.dll' name 'GetWindowDC';

Такая запись обеспечивает одновременно и статическое подключение библиотеки user32, и декларацию функции GetWindowDC, что позволяет компилятору в дальнейшем работать с ней. Обратите внимание, что все функции Win API написаны в соответствии с моделью вызова stdcall, а в Delphi по умолчанию используется другая модель - register (модель вызова определяет, как функции передаются параметры). Поэтому при импорте функций из стандартных библиотек необходимо явно указывать эту модель. Далее указывается, из какой библиотеки импортируется функция и какое название в ней она имеет. Дело в том, что имя функции в библиотеке может не совпадать с тем, под которым она становится известна компилятору. Позже я остановлюсь на тех случаях, когда это используется. Главным недостатком DLL следует считать то, что в них сохраняется информация только об именах функций, но не об их параметрах. Поэтому, если при импорте функции указать не те параметры, какие подразумевались автором DLL, то программа будет работать неправильно (вплоть до зависания), а ни компилятор, ни операционная система не смогут указать на ошибку.

Обычно программа использует довольно большое число функций Win API. Декларировать их все довольно утомительно. К счастью, Delphi избавляет программиста от этой работы: все эти функции уже описаны в соответствующих модулях, достаточно упомянуть их имена в разделе uses. Например, большинство общеупотребительных функций описаны в модулях Windows.dcu и Messages.dcu.

Как получить справку по функциям Win API.

Для тех, кто решил использовать Win API, самым необходимым инструментом становится какая-либо документация по этим функциям. Их так много, что запомнить все совершенно нереально, поэтому работа без справочника под рукой просто невозможна. Наиболее доступным справочником для российского программиста является Win32 Developer's Reference, справочная система фирмы Microsoft, потому что фирма Inprise (тогда ещё Borland), получила лицензию на включение её в состав Delphi. Сам я буду постоянно ссылаться на эту справку, потому что подробное описание функций займёт слишком много места, да и нет особого смысла описывать то, что описали и без меня.

Хотя в комплект поставки Delphi и входит эта справочная система, содержащая описание всех функций Win API, получение справки по ним не настолько удобное, как по стандартным функциям Delphi. Если набрать в редакторе Delphi имя какой-нибудь функции Win API, поставить курсор в начало этой функции и нажать F1, то откроется справка по ней, как и в случае обычных функций и процедур. Однако функции Win API не появляются в предметном указателе справочной системы. Авторы Delphi объясняют это ограничениями, накладываемыми самой справочной системой (как обычно, всех собак вешают Windows). Они же советуют создать в меню кнопки <Пуск> ярлык к справочной системе Win32 Developer's Reference. Мне остаётся только присоединиться к этому совету и добавить, что ярлык надо создавать к файлу MSTools.hlp, который находится в директории $(Delphi)\Help.

Другая проблема заключается в том, что, так как система Windows написана на Си, все описания функций Win API даны в соответствии с синтаксисом именно этого языка, а не Паскаля. Во-первых, необходимо разобраться с типами. Ниже приведена таблица, какие типы Си чему соответствуют.

WCHAR = WideChar;

LPSTR = PChar;

LPCSTR = PChar;

LPWSTR = PWideChar;

LPCWSTR = PWideChar;

DWORD = Integer;

BOOL = LongBool;

PBOOL = ^BOOL;

PINT = ^Integer;

PWORD = ^Word;

PDWORD = ^DWORD;

LPDWORD = PDWORD;

UCHAR = Byte;

PUCHAR = ^Byte;

SHORT = Smallint;

UINT = Integer;

PUINT = ^UINT;

ULONG = Longint;

PULONG = ^ULONG;

LCID = DWORD;

LANGID = Word;

Int = Integer;

Long = LongInt;

PVOID = Pointer;

HANDLE = THandle;

LPPOINT = TPoint;

RECT = TRect;

LPRECT = PRect;

LPSIZE = PSize;

BITMAP = TBitmap;

Все типы, приведённые в первой части таблицы, в целях совместимости описаны в модуле Windows.dcu, поэтому их можно использовать наравне с обычными типами Delphi. Кроме этих типов общего назначения существуют ещё специальные. Например, дескриптор окна имеет тип HWND, первый параметр сообщения - тип WPARAM. Эти специальные типы также описаны в Windows.dcu. В некоторых имена типов, встречающихся в справке, и соответствующих им типов из Windows.dcu отличаются только добавлением буквы , как это можно видеть из второй части таблицы. Кстати, не следует путать тип TBitmap, определённый в Windows.dcu, с классом TBitmap, определённым в Graphics.dcu. Зачем разработчикам Delphi потребовалось называть разные типы одним именем, не понятно, тем более что во второй версии Delphi был тип BITMAP, который куда-то исчез в третьей. Зато в четвёртой версии снова появился BITMAP, остался TBitmap, да ещё добавился tagBITMAP, и все эти три типа означают то же самое.

Теперь о синтаксисе описания самой функции в Си. Оно имеет вид.

<Тип функции> <Имя функции>(<Тип параметра> <Имя параметра>, <Тип параметра> <Имя параметра>, ...);

Еще в Си различается верхний и нижний регистр, поэтому идентификаторы HDC, hdc, hDC и т. д. - разные идентификаторы (автор Си очень любил краткость и хотел, чтобы можно было делать не 26, а 52 переменные с именем из одной буквы). Поэтому часто можно встретить, что имя параметра и его тип совпадают с точностью до регистра. К счастью, при описании функции в Delphi мы не обязаны сохранять имена параметров, значение имеют лишь их типы и порядок следования. С учётом всего этого функция, описанная в справке как.

HMETAFILE CopyMetaFile(HMETAFILE hmfSrc, LPCTSTR lpszFile);

В Delphi имеет вид.

Function CopyMetaFile(hmfSrc: HMETAFILE; lpszFile: LPCTSTR): HMETAFILE;

Или, что то же самое,

Function CopyMetaFile(hmfSrc: HMetaFile; lpszFile: PChar): HMetaFile;

Так как в Паскале нет разницы, написать, например, HMETAFILE или HMetaFile, в дальнейшем я буду придерживаться второго варианта, потому что так легче читать, хоть это и не совпадает с тем, как принято в справочной системе.

Несколько особняком стоит тип VOID. Если функция имеет такой тип, то в Паскале она описывается как процедура. Если вместо параметров у функции в скобках стоит VOID, это означает, что функция не имеет параметров. Например, функция.

Void CloseLogFile(VOID);

В Delphi описывается как.

Procedure CloseLogFile;

Не путайте VOID и PVOID. PVOID - это нетипизированный указатель, соответствующий типу Pointer.

В тех случаях, когда тип параметра является указателем на другой тип (обычно начинается с букв LP), при описании этой функции в Delphi можно пользоваться параметром-переменной, так как в этом случае функции передаётся указатель. Например, функция.

Int GetRgnBox(HRGN hrgn, LPRECT lprc);

В файле Windows.pas описана.

Function GetRgnBox(RGN: HRGN; var p2: TRect): Integer;

И, наконец, если не удаётся понять, как функция, описанная в справке, должна быть переведена на Паскаль, можно попытаться найти описание этой функции в исходных текстах модулей, поставляемых вместе с Delphi. Эти модули находятся в директории $(DELPHI)\Source\RTL\Win. Можно также воспользоваться подсказкой, которая всплывает в редакторе Delphi после того, как будет набрано имя функции.

Если посмотреть справку, например, по функции GetSystemMetrics, то видно, что эта функция должна иметь один целочисленный параметр. Однако далее в справке предлагается при вызове этой функции подставлять в качестве параметра не числа, а SM_ARRANGE, SM_CLEANBOOT и т. д. Подобная ситуация и со многими другими функциями Win API. Все эти SM_ARRANGE, SM_CLEANBOOT и т. д. являются именами числовых констант. Эти константы описаны в том же модуле, в котором описана функция, использующая их, поэтому можно не выяснять численные значения этих констант, а указывать при вызове функций их имена, например, GetSystemMetrics(SM_Arrange); Если по каким-то причинам всё-таки потребовалось выяснить численные значения, то в справочной системе их искать не стоит - их там нет. Я могу только опять отправить к исходным текстам модулей Delphi, в которых эти константы описаны. Так, например, просматривая Windows.pas, можно узнать, что SM_ARRANGE = 56. Кстати, всем, кто решиться самостоятельно просматривать исходники, я очень рекомендую использовать для этого не текстовый редактор, а программу, которая может только показать, но не изменить файл (что-то вроде просмотра по F3 в Norton Соmmаndеr'е). Так безопаснее. Или же стоит подумать о резервной копии.

В описании многих функций Win API вверху можно увидеть три ссылки: QuickInfo, Overview и Group. Первая даёт краткую информацию о функции. Самой полезной частью этой информации является то, для каких версий Windows эта функция реализована. Например, очень полезна функция MaskBlt, однако QuickInfo показывает, что она реализована только в Windows NT. Программа, использующая эту функцию, не будет работать в Windows 95. Иногда напротив названия одной из систем стоит слово , которое переводится как <пень>, <обрубок> (например, для функции GetDeviceGammaRamp это слово стоит напротив Windows NT). Это означает, что в данной версии эта функция присутствует (то есть обращение к ней не вызывает ошибки), но ничего не делает. Оставим на совести программистов из Microsoft вопрос, зачем нужны такие пни. Overview - это краткий обзор какой-то большой темы. Например, для любой функции, работающей с растровыми изображениями, обзор будет в двух словах объяснять, зачем в принципе нужны эти самые растровые изображения. Судя по непроверенным данным, первоначально эти обзоры замышлялись как нечто большее, но потом остановились на таких вот лаконичных фразах. Как бы то ни было, найти в обзоре полезную информацию удаётся крайне редко, поэтому заглядывать туда стоит только если ну совсем ничего не понятно. И, наконец, Group. Эта ссылка приводит к списку всех функций, родственных данной. Например, для функции CreateRectRgn группу будут составлять все функции, имеющие отношение к регионам. Если теперь нажимать на кнопку << (два знака <меньше>) сразу под главным меню окна справки, то будут появляться страницы с кратким описанием возможных применений объектов, с которыми работают функции (в приведённом примере описание возможностей регионов). Чтобы читать их в нормальной последовательности, лучше всего нажать на <<; столько раз, сколько возможно, а затем пойти в противоположном направлении с помощью кнопки >>;.

Иногда в справке можно встретить указания или . К этим замечаниям следует относится критически, так как справка написана для Windows 95, когда ещё не было Windows NT 4.0, описывается версия со старым интерфейсом. Так что то, про что написано , может вполне успешно работать и в Windows NT 4.0 и выше, особенно если это <что-то> связано с пользовательским интерфейсом. То же самое относится и к QuickInfo. Такие вещи лучше всего проверять на практике.

Ещё несколько слов о числовых константах. В справке можно встретить числа вида, например, 0xC56F или 0x3341. Префикс <0x> в Си означает шестнадцатеричное число. В Delphi надо его заменить на <$>, то есть вышеназванные числа должны быть записаны как $C56F и $3341 соответственно.

Дескрипторы вместо классов.

Программируя в Delphi, мы быстро привыкаем к тому, что каждый объект реализуется экземпляром соответствующего класса. Например, кнопка реализуется экземпляром класса TButton, контекст устройства - классом TCanvas. Но когда создавались первые версии Windows, объектно-ориентированный метод программирования ещё не был общепризнанным, поэтому он не был реализован. Современные версии Windows частично унаследовали этот недостаток, поэтому в большинстве случаев приходится работать по старинке, тем более что DLL могут экспортировать только функции, но не классы.

Когда мы создаём некоторый объект в Windows, ему присваивается уникальный 32-разрядный номер, называемый дескриптором. В дальнейшем при работе с этим объектом каждой функции передаётся этот дескриптор. В этом и заключается главное различие между методами класса и функциями Win API. Первые связаны с тем экземпляром класса, через который они вызыва-ются, и поэтому не требуют явного указания на объект. Вторым необходимо такое указание, так как они сами по себе никак не связаны ни с одним объектом.

Не следует думать, что при работе с Win API следует полностью отказываться от классов Delphi. Эти методы прекрасно работают вместе. Правда, внутренние механизмы Delphi не могут включиться, если изменение объекта происходит через Win API. Например, если спрятать окно не с помощью метода Hide, а с помощью вызова функции Win API ShowWindow(Handle, SW_Hide), не возникнет событие OnHide, потому что оно запускается теми самыми внутренними механизмами Delphi. Но такие недоразумения случаются обычно только тогда, когда функциями Win API дублируется то, что можно сделать и с помощью Delphi. Для вызова функций Win API объекта, созданного с помощью Delphi, используйте свойство Handle. В нём хранится дескриптор.

В некоторых случаях класс Delphi инкапсулирует несколько объектов Windows. Например, класс TBitmap включает в себя HBitmap и HPalette - картинку и палитру к ней. Соответственно, он хранит два дескриптора - в свойствах Handle и Palette.

Все экземпляры классов, созданные в Delphi, должны удаляться. В некоторых случаях это происходит автоматически, в некоторых программист должен сам позаботиться о <выносе му-сора>. Аналогичная ситуация и с объектами, создаваемыми в Win API. Если посмотреть справку по функции, создающей какой-то объект, то там обязательно будет информация о том, какой функцией можно удалить объект и может ли система сделать это автоматически. Во многих случаях совершенно разные объекты могут удаляться одной и той же функцией. Так, функция DeleteObject удаляет косметические карандаши, геометрические карандаши, кисти, шрифты, регионы, растровые изображения и палитры. Обращайте внимание на возможные исключения. Например, регионы не удаляются системой автоматически, однако если вызвать для региона функцию SetWindowRgn, то этот регион переходит в собственность операционной системы. Никакие дальнейшие операции с ним, в том числе и удаление, совершать нельзя.

Формы Delphi и окна Windows.

Принято считать, что класс TForm реализует окно. Это не совсем верно, потому что TForm реализует лишь часть тех объектов, которые принято называть окнами. Например, кнопка - это тоже окно, но реализуется она классом TButton.

Каждое окно принадлежит к какому-то оконному классу. Не следует путать оконный класс с классами Delphi. Это некий шаблон, определяющий базовые свойства окна. Каждому такому шаблону присваивается имя, уникальное в его области видимости. Классы делятся на локальные (видимые только в приложении, регистрирующем их) и глобальные (видимые вне прило-жения). В 16-разрядных версиях Windows локальный класс, зарегистрированный приложением, был виден всем другим экземплярам этого же приложения. В 32-разрядных версиях различные экземпляры одного приложения стали более самостоятельными, поэтому каждый экземпляр должен заново регистрировать все свои классы. Перед использованием класс необходимо зарегистрировать ( функция RegisterClassEx). При завершении программы все классы, зарегистрированные в ней, удаляются автоматически, хотя при необходимости их можно удалить и самостоятельно. Отсюда очевидно, что глобальный оконный класс, доступный всем программам, должен быть зарегистрирован динамической библиотекой, постоянно находящейся в памяти. Как это сделать, можно прочитать в Win32 Developer's Reference, тема WNDCLASS. Если же глобальный класс регистрируется программой обычным образом, то это означает, что он будет доступен не только самой программе, но и всем библиотекам, вызванным ею, но никак не другим программам и не другим экземплярам этой программы. Если наоборот, глобальный класс регистрирует DLL, то он становится доступным всем программам, использующим эту DLL. Но в этом случае класс не удаляется автоматически.

При создании окна обязательно указывать его класс. Данный класс должен быть к этому моменту зарегистрирован. В Delphi имя оконного класса для окон, созданных наследниками TForm, всегда совпадает с именем класса Delphi. Существуют предопределённые классы Windows, которые не надо регистрировать. Это 'BUTTON', 'COMBOBOX', 'EDIT', 'LISTBOX', 'MDICLIENT', 'SCROLLBAR' и 'STATIC'. Назначение этих классов понятно из их названий (класс 'STATIC' реализует статические, то есть не реагирующие на мышь и клавиатуру, но имеющие дескриптор элементы, текстовые или графические). Впрочем, можно определить локальный класс с зарезервированным именем, он перекроет глобальный в пределах приложения.

Кроме имени, класс включает в себя другие параметры, такие как стиль, кисть и т. д. Они подробно перечислены в справке по теме WNDCLASS.

Кроме класса нужно указать стиль окна и расширенный стиль. Они определяют поведение конкретного окна и не имеют ничего общего со стилем класса. Возможные значения этих стилей перечислены в справке по функциям CreateWindow и CreateWindowEx. Результатом работы этих функций является дескриптор созданного ими окна.

Функции, создающие окна, требуют указать дескриптор приложения. В Delphi этот дескриптор хранится стразу в двух переменных - MainInstance модуля System и HInstance модуля SysInit. Оба эти модуля автоматически подключаются к любому модулю, созданному в Delphi, так что можно использовать ту или иную переменную по своему вкусу. Кстати, не следует путать автоматическое подключение этих модулей с автоматической генерацией кода IDE Delphi для под-ключения таких модулей, как Windows, Forms, SysUtils и т. д. В первом случае модули подключаются несмотря на то, что не упомянуты в списке uses. Более того, их упоминание там приведёт к ошибке. Во втором случае эти модули явным образом подключаются, просто Delphi автоматически пишет эту часть программы за программиста. Можно написать модуль или даже целую программу, которые не будут использовать SysUtils, но нельзя написать такие, которые не будут использовать System.

Создание окон через Win API требует кропотливой работы. VCL Delphi справляется с этой задачей замечательно, поэтому создавать окна самостоятельно приходится только тогда, когда использование VCL нежелательно, например, если необходимо написать как можно более компактное приложение. Во всех остальных случаях приходится только слегка подправлять работу VCL. Например, с помощью Win API можно изменить форму окна или убрать из него заголовок, оставив рамку. Подобные действия не требуют от программиста создания нового окна, можно воспользоваться тем, что уже создано VCL.

Другой случай, когда могут понадобиться функции Win API для окон - если приложение должно что-то делать с чужими окнами. Например, хотя бы просто перечислить все окна, открытые в данный момент, как это делает WinSight32. Но в этом случае также не приходится самому создавать окна, работа идёт с уже имеющимися.

Callback функции.

Прежде чем двигаться дальше, необходимо разобраться с тем, что такое callback функции. На русский язык это обычно переводится как функции косвенного вызова. Эти функции в программе описываются, но обычно не вызываются напрямую, хотя ничто не запрещает сделать это. В этом они похожи на те методы класса, которые связаны с событиями. Ничто не мешает вызывать напрямую, например, метод FormCreate, но делать это приходится крайне редко. С другой стороны, даже если этот метод не вызывается явно, он всё равно выполняется, потому что VCL автоматически вызывает его без прямого указания программиста. Еще одно общее свойство - конкретное имя метода при косвенном вызове не важно. Можно изменить его, но если этот метод по-прежнему будет связан с событием OnCreate, он так же будет успешно вызываться. Разница заключается только в том, что такие методы вызываются внутренними механизмами Delphi, а callback функции - самой системой Windows. Соответственно, на эти функции налагаются следующие требования: во-первых, эти функции должны быть именно функциями, а не методами класса (впрочем, иногда это условие удаётся обойти); во-вторых, эти функции должны быть написаны в соответствии с моделью вызова stdcall. Справочная система предлагает использовать модель callback, которая в имеющихся версиях Windows совпадает с stdcall. Однако в Delphi такая модель не поддерживается. Что же касается того, как программист сообщает системе о том, что он написал callback функцию, то это в каждом случае по-своему.

Очень часто функции косвенного вызова используются при перечислении некоторых объектов. В качестве примера рассмотрим перечисление окон с помощью функции EnumWindows. В справке она описана так:

BOOL EnumWindows(WNDENUMPROC lpEnumFunc, LPARAM lParam);

Соответственно, в Windows.pas она имеет вид.

Function EnumWindows(lpEnumFunc: TFNWndEnumProc; lParam: LPARAM): BOOL; stdcall;

Тип TFNWndEnumProc совпадает с типом Pointer. Здесь должен стоять указатель на callback функцию. Синтаксис этой функции описан так:

BOOL CALLBACK EnumWindowsProc(HWND hwnd, LPARAM lParam);

Функции с таким именем не существует в Win API. Это так называемый прототип функции, согласно которому следует описывать callback функцию. На самом деле этот прототип предоставляет большую свободу, чем это может показаться на первый взгляд. Как я уже сказал выше, имя может быть любым. Любыми могут быть и типы функции и параметров, при условии что новые типы совпадают по размерам с теми, которые указываются. Что касается типа функции и типа первого параметра, то они имеют определённый смысл и менять их тип практически бессмысленно. Другое дело со вторым параметром. Он предназначен специально для передачи значения, которое программист волен использовать по своему усмотрению, система не имеет на него никаких видов. А программисту может показаться удобнее работать не с типом LPARAM (то есть LongInt), а, например, с указателем или же с массивом из четырёх байт. Лишь бы были именно четыре байта, а не восемь, шестнадцать или ещё какое-то число. Можно даже превратить этот параметр в параметр-переменную, так как при этом функции будут передаваться всё те же четыре байта - адрес переменной. Но эти удовольствия для тех, кто хорошо разбирается с тем, как используется стек для передачи параметров при различных моделях вы-зова.

Как же работает EnumWindows? После вызова эта функция начинает по очереди перебирать все имеющиеся в данный момент окна верхнего уровня, то есть те, у которых нет родителя. Для каждого такого окна вызывается эта самая callback функция, в качестве первого параметра ей передаётся дескриптор данного окна (каждый раз, естественно, новый), в качестве второго - то, что было передано самой функции EnumWindows в качестве второго параметра (каждый раз одно и то же). Что же может делать callback функция с этим дескриптором? А всё, на что у программиста хватит фантазии. Например, можно минимизировать или вообще закрыть все эти окна, хотя не понятно, с чего бы вдруг устраивать такую диверсию. Или можно проверять все эти окна на соответствие какому-то условию, пытаясь найти нужное. А значение, возвращаемое callback функцией, влияет на работу EnumWindows. Если она возвращает False, значит, всё, что нужно, уже сделано, можно не перебирать остальные окна.

Окончательный код для того случая, когда второй параметр имеет тип Pointer, выглядит так:

Code: Function MyCallbackFunction(Wnd:HWnd; P: Pointer):Bool; stdcall; Begin. { что-то делаем }. End; .............. Var MyPointer:Pointer; .............. EnumWindows(@MyCallbackFunction, LongInt(MyPointer));

Как получить список процессов в Win9x.

Эта функция возвращает результат: запущено ли приложение, переданное ей в качестве параметра. Функция просматривает список всех процессов и делает вывод.

Code: Function IsRunning( sName : string ) : boolean; Var. Han : THandle; ProcStruct : PROCESSENTRY32; // from "tlhelp32" in uses clause. SID : string; Begin. Result := false; // Get a snapshot of the system. Han := CreateToolhelp32Snapshot( TH32CS_SNAPALL, 0 ); If han = 0 then. Exit; // Loop thru the processes until we find it or hit the end. ProcStruct.dwSize := sizeof( PROCESSENTRY32 ); If Process32First( han, ProcStruct ) then. Begin. Repeat. SID := ExtractFileName( ProcStruct.szExeFile ); // Check only against the portion of the name supplied, ignoring case. If uppercase( copy( sId, 1, length( sName ) ) ) = uppercase( sName ) then. Begin. // Report we found it. Result := true; Break; End; Until not Process32Next( han, ProcStruct ); End; // clean-up. CloseHandle( han ); End;

Поиск значения типа DWORD в указанном процессе.

Code: // // Поиск значения типа DWORD в указанном процессе. // paul_shmakov@mail.ru. // Program search; {©Drkb v.3(2007): www.drkb.ru}. {$APPTYPE CONSOLE}. Uses Windows, SysUtils; Var. ProcessID: DWord; ProcessHandle: THandle; Mbi: TMemoryBasicInformation; Addr: DWord; Value: DWord; I: Cardinal; Buf: PChar; BytesRead: DWord; Begin. If ParamCount < 2 then. Begin. WriteLn('Usage: search.exe processid value'); Exit; End; ProcessID := StrToInt(ParamStr(1)); WriteLn('Process id: ' + IntToStr(ProcessID)); Value := StrToInt(ParamStr(2)); WriteLn('Value to search: ' + IntToStr(Value)); // // Открываем процесс. // ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or. PROCESS_VM_OPERATION, false, ProcessID); If ProcessHandle <> 0 then. Try. Addr := 0; // // Перечисляем все регионы виртуальной памяти процесса. // While VirtualQueryEx(ProcessHandle, Pointer(Addr), Mbi, SizeOf(Mbi)) <> 0 do. Begin. // Uncomment чтобы увидеть список регионов, найденых в адресном пространстве. // WriteLn('region: ' + IntToHex(Integer(Mbi.BaseAddress), 8) + // ' size: ' + IntToStr(Mbi.RegionSize)); // // Если региону выделена память, и регион не является "сторожевым" (как вершина стека), // то читаем этот регион. // If (Mbi.State = MEM_COMMIT) and not ((Mbi.Protect and PAGE_GUARD) = PAGE_GUARD) then. Begin. // // Это демонстрационная программа, поэтому здесь выделяется буфер под весь регион. // Регион может быть достаточно большим, поэтому лучше читать его блоками для экономии. // памяти. Но здесь для простоты алгоритма вся оптимизация похерена. // GetMem(Buf, Mbi.RegionSize); Try. // // Читаем весь регион в выделенный буфер. // If ReadProcessMemory(ProcessHandle, Mbi.BaseAddress, Buf, Mbi.RegionSize, BytesRead) then. Begin. // // Ищем значение типа DWORD в буфере. // For I := 0 to BytesRead - SizeOf(Value) do. Begin. If PDWord(@Buf[I])^ = Value then. // Найдено, выводим. WriteLn('Value ' + IntToStr(Value) + ' found at ' + IntToHex(Integer(Cardinal(Mbi.BaseAddress) + I), 8)); End; End. Else. WriteLn('Failed to read process memory ' + IntToStr(GetLastError)); Finally. FreeMem(Buf); End; End; // Вычисляем адрес следуюшего региона. Addr := Addr + Mbi.RegionSize; End; Finally. CloseHandle(ProcessHandle); End. Else. WriteLn('Failed to open process'); End. А вот программа, в которой ведем поиск для примера: Program someprog; {$APPTYPE CONSOLE}. Uses SysUtils; Var. SomeValue: Integer; Begin. SomeValue := 12345; WriteLn('One variable of this program has a value ' + IntToStr(SomeValue)); WriteLn('Press any key to exit'); ReadLn; End.

Как определить использует ли пользователь стили?

Code: Function _IsThemeActive: Boolean; // Returns True if the user uses XP style. Const. Themelib = 'uxtheme.dll'; Type. TIsThemeActive = function: BOOL; stdcall; Var. IsThemeActive: TIsThemeActive; Huxtheme: HINST; Begin. Result := False; // Check if XP or later Version. If (Win32Platform = VER_PLATFORM_WIN32_NT) and. (((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or. (Win32MajorVersion > 5)) then. Begin. Huxtheme := LoadLibrary(themelib); If huxtheme <> 0 then. Begin. Try. IsThemeActive := GetProcAddress(huxtheme, 'IsThemeActive'); Result := IsThemeActive; Finally. If huxtheme > 0 then. FreeLibrary(huxtheme); End; End; End; End; // Example Call: Procedure TForm1.Button1Click(Sender: TObject); Begin. If _IsThemeActive then. ShowMessage('Windows Themes are active.'); End;

Как спрятать программу от TaskManager в WindowsXP и 2000.

Этот вопрос меня уже достал, он задаётся на всех программистских форумах, поэтому я выкладываю solution. Листинг библиотеки (nthide.dll), которая будет выполнять нужную нам функцию:

Code: Library hide; Uses. Windows, SysUtils, ImageHlp, TlHelp32; Type SYSTEM_INFORMATION_CLASS = ( SystemBasicInformation, SystemProcessorInformation, SystemPerformanceInformation, SystemTimeOfDayInformation, SystemNotImplemented1, SystemProcessesAndThreadsInformation, SystemCallCounts, SystemConfigurationInformation, SystemProcessorTimes, SystemGlobalFlag, SystemNotImplemented2, SystemModuleInformation, SystemLockInformation, SystemNotImplemented3, SystemNotImplemented4, SystemNotImplemented5, SystemHandleInformation, SystemObjectInformation, SystemPagefileInformation, SystemInstructionEmulationCounts, SystemInvalidInfoClass1, SystemCacheInformation, SystemPoolTagInformation, SystemProcessorStatistics, SystemDpcInformation, SystemNotImplemented6, SystemLoadImage, SystemUnloadImage, SystemTimeAdjustment, SystemNotImplemented7, SystemNotImplemented8, SystemNotImplemented9, SystemCrashDumpInformation, SystemExceptionInformation, SystemCrashDumpStateInformation, SystemKernelDebuggerInformation, SystemContextSwitchInformation, SystemRegistryQuotaInformation, SystemLoadAndCallImage, SystemPrioritySeparation, SystemNotImplemented10, SystemNotImplemented11, SystemInvalidInfoClass2, SystemInvalidInfoClass3, SystemTimeZoneInformation, SystemLookasideInformation, SystemSetTimeSlipEvent, SystemCreateSession, SystemDeleteSession, SystemInvalidInfoClass4, SystemRangeStartInformation, SystemVerifierInformation, SystemAddVerifier, SystemSessionProcessesInformation. ); _IMAGE_IMPORT_DESCRIPTOR = packed record. Case Integer of. 0:( Characteristics: DWORD); 1:( OriginalFirstThunk:DWORD; TimeDateStamp:DWORD; ForwarderChain: DWORD; Name: DWORD; FirstThunk: DWORD); End; IMAGE_IMPORT_DESCRIPTOR=_IMAGE_IMPORT_DESCRIPTOR; PIMAGE_IMPORT_DESCRIPTOR=^IMAGE_IMPORT_DESCRIPTOR; PFARPROC=^FARPROC; Procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule); Var ulSize: ULONG; PImportDesc: PIMAGE_IMPORT_DESCRIPTOR; PszModName: PChar; PThunk: PDWORD; ppfn:PFARPROC; Ffound: LongBool; Written: DWORD; Begin. PImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize); If pImportDesc = nil then exit; While pImportDesc.Name<>0 do. Begin. PszModName := PChar(hmodCaller + pImportDesc.Name); If (lstrcmpiA(pszModName, pszCallerModName) = 0) then break; Inc(pImportDesc); End; If (pImportDesc.Name = 0) then exit; PThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk); While pThunk^<>0 do. Begin. Ppfn := PFARPROC(pThunk); FFound := (ppfn^ = pfnCurrent); If (fFound) then. Begin. VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written); WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written); Exit; End; Inc(pThunk); End; End; Var. Addr_NtQuerySystemInformation: Pointer; Mypid: DWORD; Fname: PCHAR; Mapaddr: PDWORD; HideOnlyTaskMan: PBOOL; Function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer; SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall; Label onceagain, getnextpidstruct, quit, fillzero; Asm. Push ReturnLength. Push SystemInformationLength. Push SystemInformation. Push dword ptr SystemInformationClass. Call dword ptr [addr_NtQuerySystemInformation]. Or eax,eax. Jl quit. Cmp SystemInformationClass, SystemProcessesAndThreadsInformation. Jne quit. Onceagain: Mov esi, SystemInformation. Getnextpidstruct: Mov ebx, esi. Cmp dword ptr [esi],0. Je quit. Add esi, [esi]. Mov ecx, [esi+44h]. Cmp ecx, mypid. Jne getnextpidstruct. Mov edx, [esi]. Test edx, edx. Je fillzero. Add [ebx], edx. Jmp onceagain. Fillzero: And [ebx], edx. Jmp onceagain. Quit: Mov Result, eax. End. Procedure InterceptFunctions; Var hSnapShot: THandle; Me32: MODULEENTRY32; Begin. Addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation'); HSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId); If hSnapshot=INVALID_HANDLE_VALUE then exit; Try. ZeroMemory(@me32,sizeof(MODULEENTRY32)); Me32.dwSize:=sizeof(MODULEENTRY32); Module32First(hSnapShot,me32); Repeat. ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule); Until not Module32Next(hSnapShot,me32); Finally. CloseHandle(hSnapShot); End; End; Procedure UninterceptFunctions; Var hSnapShot: THandle; Me32: MODULEENTRY32; Begin. Addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation'); HSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId); If hSnapshot=INVALID_HANDLE_VALUE then exit; Try. ZeroMemory(@me32,sizeof(MODULEENTRY32)); Me32.dwSize:=sizeof(MODULEENTRY32); Module32First(hSnapShot,me32); Repeat. ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule); Until not Module32Next(hSnapShot,me32); Finally. CloseHandle(hSnapShot); End; End; Var HookHandle: THandle; Function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall; Begin. Result:=0; End; Procedure InstallHook; stdcall; Begin. HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0); End; Var hFirstMapHandle:THandle; Function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall; Var addrMap: PDWORD; Ptr2: PBOOL; Begin. Mypid:=0; Result:=false; HFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping'); If hFirstMapHandle=0 then exit; AddrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8); If addrMap=nil then. Begin. CloseHandle(hFirstMapHandle); Exit; End; AddrMap^:=pid; Ptr2:=PBOOL(DWORD(addrMap)+4); Ptr2^:=HideOnlyFromTaskManager; UnmapViewOfFile(addrMap); InstallHook; Result:=true; End; Exports. HideProcess; Var. Hmap: THandle; Procedure LibraryProc(Reason: Integer); Begin. If Reason = DLL_PROCESS_DETACH then. If mypid > 0 then. UninterceptFunctions(). Else. CloseHandle(hFirstMapHandle); End; Begin. Hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping'); If hmap=0 then exit; Try. Mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0); If mapaddr=nil then exit; Mypid:=mapaddr^; HideOnlyTaskMan:=PBOOL(DWORD(mapaddr)+4); If hideOnlyTaskMan^ then. Begin. Fname:=allocMem(MAX_PATH+1); GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1); If not (ExtractFileName(fname)='taskmgr.exe') then exit; End; InterceptFunctions; Finally. UnmapViewOfFile(mapaddr); CloseHandle(Hmap); DLLProc:=@LibraryProc; End; End.

Получить текст окна, где этого не может WM_GETTEXT.

Она может брать текст, где этого не может делать GetWindowText(), вот собственно и все!

Должна работать и в win98, но небыло возможности проверить.... =).

Так что кому надо... Отделбное спасибо .аlех'у.

Code: Program pGrabber; Uses. Windows, Myfuncs in 'myfuncs.pas'; Const. WM_CREATE = $0001; WM_DESTROY = $0002; WM_SETTEXT = $000C; WM_GETTEXT = $000D; WM_TIMER = $0113; WM_GETTEXTLENGTH = $000E; EM_GETPASSWORDCHAR = $00D2; WM_COMMAND = $0111; Var. Wc : TWndClass; Hwnd : THandle; MMsg : TMsg; Ehwnd : THandle; Function GetTextPODCursor: PChar; Var grabtext: array[0..125] of char; LpPoint: TPoint; Hwnd: THandle; Begin. GetCursorPos(lpPoint); Hwnd := WindowFromPoint(lpPoint); If (SendMessage(hwnd, EM_GETPASSWORDCHAR, 0, 0) <> 0) then. Begin. SendMessage(hwnd, WM_GETTEXT, 20, Integer(PChar(@grabtext))); Result := PChar(@grabtext); End else. Result := PChar(''); SendMessage(ehwnd, WM_SETTEXT, 0, Integer(result)); End; ////////////////////// // Main Window Proc // ////////////////////// Function WndProc(hwnd: Thandle; lMsg, wParam, lParam: LongInt): LongInt; stdcall; Begin. Case lMsg of. WM_CREATE: Begin. SetWindowPos(hwnd,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE + SWP_NOMOVE); SetTimer(hwnd, 55555, 2*1000, nil); End; WM_TIMER: Begin. If (not IsNT)then GetTextPODCursor else SpawnThreadNT('EXPLORER.EXE', GetModuleHandle(nil)); End; WM_DESTROY: Begin. KillTimer(hwnd, 55555); Halt(0); End; End; Result:=DefWindowProc(hWnd, lMsg, wParam, lParam); End; ////////////////////// // Main Entry Point // ////////////////////// Begin. With wc do begin. Style := CS_HREDRAW or CS_VREDRAW; LpfnWndProc := @WndProc; CbClsExtra := 0; CbWndExtra := 0; HInstance := hInstance; HIcon := 65539; HCursor := 65553; HbrBackground := 26214418; LpszMenuName := nil ; LpszClassName := 'pGClass'; End; RegisterClass(wc); Hwnd := CreateWindow('pGClass',' pGrabber [win98/Xp v2.0] by xZero',WS_OVERLAPPEDWINDOW and WS_DLGFRAME,400,300,260,65,0,0,hInstance,nil); Ehwnd := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', '',WS_CHILD or WS_VISIBLE or ES_READONLY, 5, 5, 245, 20, hwnd, 0, hInstance, nil); ShowWindow(hwnd, SW_SHOW);UpdateWindow(hwnd); While GetMessage(mMsg, hwnd , 0, 0) do. Begin. TranslateMessage(mMsg); DispatchMessage(mMsg); End; Halt(mMsg.wParam); End.

Code: Unit myfuncs; Interface. Uses windows, tlhelp32; Function IsNT: boolean; Function OPTHDROFFSET(ptr: LongInt): DWORD; Function SpawnThreadNT(pszProcess: PChar; g_hModule: HMODULE): boolean; Procedure EntryPoint; Implementation. Const. EM_GETPASSWORDCHAR = $00D2; WM_SETTEXT = $000C; WM_GETTEXT = $000D; Function IsNT: boolean; Var. Osvi: OSVERSIONINFO; Begin. Osvi.dwOSVersionInfoSize := sizeof(OSVERSIONINFO); If(not GetVersionEx(osvi))then. Begin. Result := FALSE; Exit; End; If(osvi.dwPlatformId <> VER_PLATFORM_WIN32_NT)then. Result := FALSE. Else. Result := TRUE; End; Function OPTHDROFFSET(ptr: LongInt): DWORD; Begin. Result := PImageOptionalHeader(int64(ptr) + PImageDosHeader(ptr)._lfanew + sizeof(DWORD) + sizeof(IMAGE_FILE_HEADER)).SizeOfImage; End; Function SpawnThreadNT(pszProcess: PChar; g_hModule: HMODULE): boolean; Var. DwProcID: DWORD; HToolHelp: THandle; Pe: PROCESSENTRY32; HProc: THandle; DwSize: DWORD; PMem: Pointer; DwOldProt, dwNumBytes, i: DWORD; Mbi: TMemoryBasicInformation; DwRmtThdID: DWORD; HRmtThd: THandle; Begin. HToolHelp := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); Pe.dwSize := sizeof(pe); If(not Process32First(hToolHelp, pe))then. Begin. Result := false; Exit; End; DwProcID := 0; While(Process32Next(hToolHelp, pe))do. Begin. If(lstrcmpi(pe.szExeFile, pszProcess) = 0)then. Begin. DwProcID := pe.th32ProcessID; Break; End; End; If(dwProcID = 0)then. Begin. Result := FALSE; Exit; End; If(GetCurrentProcessId() = dwProcID)then. Begin. Result := FALSE; Exit; End; HProc := OpenProcess(PROCESS_ALL_ACCESS, FALSE, dwProcID); If(hProc = 0)then. Begin. Result := FALSE; Exit; End; VirtualFreeEx(hProc, ptr(g_hModule), 0, MEM_RELEASE); DwSize := OPTHDROFFSET(g_hModule); PMem := VirtualAllocEx(hProc, ptr(g_hModule), dwSize, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE); If(pMem = nil)then. Begin. Result := FALSE; Exit; End; VirtualQueryEx(hProc, pMem, mbi, sizeof(MEMORY_BASIC_INFORMATION)); While((mbi.Protect <> PAGE_NOACCESS) and (mbi.RegionSize <> 0))do. Begin. If((mbi.Protect and PAGE_GUARD) = 0)then. Begin. I := 0; While(i < mbi.RegionSize)do. Begin. If(not VirtualProtectEx(hProc, ptr(DWORD(pMem) + i), $1000, PAGE_EXECUTE_READWRITE, dwOldProt))then. Begin. Result := FALSE; Exit; End; If(not WriteProcessMemory(hProc, ptr(DWORD(pMem) + i), Pointer(DWORD(g_hModule) + i), $1000, dwNumBytes))then. Begin. Result := FALSE; Exit; End; I := i + $1000; End; PMem := Pointer(DWORD(pMem) + mbi.RegionSize); VirtualQueryEx(hProc, pMem, mbi, sizeof(MEMORY_BASIC_INFORMATION)); End; End; HRmtThd := CreateRemoteThread(hProc, nil, 0, @EntryPoint, ptr(g_hModule), 0, dwRmtThdID); If(hRmtThd = 0)then. Begin. Result := FALSE; Exit; End; CloseHandle(hProc); Result := TRUE; End; Procedure EntryPoint; Var. Grabtext : array[0..125] of char; LpPoint : TPoint; Hwnd : THandle; Begin. GetCursorPos(lpPoint); Hwnd := WindowFromPoint(lpPoint); If (GetParent(hwnd) <> 0)then. Begin. SendMessage(hwnd, WM_GETTEXT, 20, Integer(PChar(@grabtext))); SendMessage(FindWindowEx(FindWindow('pGClass', nil), 0, 'Edit', nil), WM_SETTEXT, 0, Integer(PChar(@grabtext))); End; End; End.

Автор x2er0.

©Drkb::02119.

Взято из http://forum.sources.ru.

Печать TStringGrid.

Code: Procedure TForm1.Button1Click(Sender: TObject); Var K: Double; Begin. Printer.BeginDoc; K := Printer.Canvas.Font.PixelsPerInch / Canvas.Font.PixelsPerInch*1.2; PrintStringGrid(StrGrid, K, // Коэффициент. 200, // отступ от края листа в пихелах по Х. 200, // --"-- по Y. 200 // отступ снизу. ); Printer.EndDoc; End; {----------------------------------------------------------} Unit GrdPrn3; Interface. Uses. Windows, Classes, Graphics, Grids, Printers, SysUtils; Const. OrdinaryLineWidth: Integer = 2; BoldLineWidth: Integer = 4; Procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin, TopMargin, BottomMargin: Integer); Function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow, LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer; // возвращает номер строки, которая не поместилась до Y = Yfloor. // не проверяет, вылезает ли общая длина таблицы за пределы страницы. // Слишком длинное слово обрежется. Implementation. Procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin, TopMargin, BottomMargin: Integer); Var NextRow: Integer; Begin. //Printer.BeginDoc; If not Printer.Printing then raise Exception.Create('function. PrintStringGrid must be called between Printer.BeginDoc. And Printer.EndDoc'); NextRow := 0; Repeat. NextRow := DrawStringGridEx(Grid, Scale, NextRow, LeftMargin, TopMargin, Printer.PageHeight - BottomMargin, Printer.Canvas); If NextRow <> -1 then Printer.NewPage; Until NextRow = -1; //Printer.EndDoc; End; Function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow, LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer; // возвращает номер строки, которая не поместилась до Y = Yfloor. Var. I, j, d, TotalPrevH, TotalPrevW, CellH, CellW, LineWidth: Integer; R: TRect; S: string; Procedure CorrectCellHeight(ARow: Integer); // вычисление правильной высоты ячейки с учетом многострочного текста. // Текст рабивается только по словам слишком длинное слово обрубается. Var. I, H: Integer; R: TRect; S: string; Begin. R := Rect(0, 0, CellH*2, CellH); S := ':)'; // Одинарная высота строки. CellH := DrawText(DestCanvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_TOP or DT_WORDBREAK or DT_SINGLELINE or. DT_NOPREFIX or DT_CALCRECT) + 3*d; For i := 0 to Grid.ColCount-1 do. Begin. CellW := Round(Grid.ColWidths[i]*Scale); R := Rect(0, 0, CellW, CellH); //InflateRect(R, -d, -d); R.Left := R.Left+d; R.Top := R.Top + d; S := Grid.Cells[i, ARow]; // Вычисление ширины и высоты. H := DrawText(DestCanvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX or DT_CALCRECT); Текста. If CellH < H + 2*d then CellH := H + 2*d; // if CellW < R.Right - R.Left then Слишком длинное слово - // не помещается в одну строку; Перенос слов не поддерживается. End; End; Begin. Result := -1; // все строки уместились между TopMargin и Yfloor. If (FromRow < 0)or(FromRow >= Grid.RowCount) then Exit; DestCanvas.Brush.Style := bsClear; DestCanvas.Font := Grid.Font; // DestCanvas.Font.Height := Round(Grid.Font.Height*Scale); DestCanvas.Font.Size := 10; Grid.Canvas.Font := Grid.Font; Scale := DestCanvas.TextWidth('test')/Grid.Canvas.TextWidth('test'); D := Round(2*Scale); TotalPrevH := 0; For j := 0 to Grid.RowCount-1 do. Begin. If (j >= Grid.FixedRows) and (j < FromRow) then Continue; // Fixed Rows рисуются на каждой странице. TotalPrevW := 0; CellH := Round(Grid.RowHeights[j]*Scale); CorrectCellHeight(j); If TopMargin + TotalPrevH + CellH > YFloor then. Begin. Result := j; // j-я строка не помещается в заданный диапазон. If Result < Grid.FixedRows then Result := -1; // если фиксированные строки не влезают на страницу - // это тяж?лый случай... Exit; End; For i := 0 to Grid.ColCount-1 do. Begin. CellW := Round(Grid.ColWidths[i]*Scale); R := Rect(TotalPrevW, TotalPrevH, TotalPrevW + CellW, OtalPrevH + CellH); OffSetRect(R, LeftMargin, TopMargin); If (i < Grid.FixedCols)or(j < Grid.FixedRows) then. LineWidth := BoldLineWidth. Else. LineWidth := OrdinaryLineWidth; DestCanvas.Pen.Width := LineWidth; If LineWidth > 0 then. DestCanvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1); //InflateRect(R, -d, -d); R.Left := R.Left+d; R.Top := R.Top + d; S := Grid.Cells[i, j]; DrawText(DestCanvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX); TotalPrevW := TotalPrevW + CellW; // Общая ширина всех предыдущих колонок. End; TotalPrevH := TotalPrevH + CellH; // Общая высота всех предыдущих строк. End; End; End.

Как получить screen shot экран вместе с указателем мыша?

Надо его вручную дорисовать.

Code: Procedure GetScreenImage(bmp: TBitmap); Var. CI: TCursorInfo; Icon: TIcon; II: TIconInfo; R: TRect; Begin. Bmp.Width:= Screen.Width; Bmp.Height:= Screen.Height; BitBlt(bmp.Canvas.Handle,0,0,Screen.Width,Screen.Height, GetDC(GetDesktopWindow),0,0,SRCCopy); //дорисуем курсор. Icon:=TIcon.Create; R:=Rect(0,0,GetSystemMetrics(SM_CXSCREEN),GetSystemMetrics(SM_CYSCREEN)); CI.cbSize:=SizeOf(CI); If (GetCursorInfo(CI)) and (CI.flags=CURSOR_SHOWING) then. Begin. Icon.Handle:=CopyIcon(CI.hCursor); If GetIconInfo(Icon.Handle,II) then. Bmp.Canvas.Draw(ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left, ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top, Icon); End; End;

Автор P.O.D.

©Drkb::01842.

Взято из http://forum.sources.ru.

Code: // 1. Get the handle to the current mouse-cursor and its position. Function GetCursorInfo2: TCursorInfo; Var. HWindow: HWND; Pt: TPoint; PIconInfo: TIconInfo; DwThreadID, dwCurrentThreadID: DWORD; Begin. Result.hCursor := 0; ZeroMemory(@Result, SizeOf(Result)); // Find out which window owns the cursor. If GetCursorPos(pt) then. Begin. Result.ptScreenPos := pt; HWindow := WindowFromPoint(pt); If IsWindow(hWindow) then. Begin. // Get the thread ID for the cursor owner. DwThreadID := GetWindowThreadProcessId(hWindow, nil); // Get the thread ID for the current thread. DwCurrentThreadID := GetCurrentThreadId; // If the cursor owner is not us then we must attach to. // the other thread in so that we can use GetCursor() to. // return the correct hCursor. If (dwCurrentThreadID <> dwThreadID) then. Begin. If AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then. Begin. // Get the handle to the cursor. Result.hCursor := GetCursor; AttachThreadInput(dwCurrentThreadID, dwThreadID, False); End; End. Else. Begin. Result.hCursor := GetCursor; End; End; End; End; // 2. Capture the screen. Function CaptureScreen: TBitmap; Var. DC: HDC; ABitmap: TBitmap; MyCursor: TIcon; CursorInfo: TCursorInfo; IconInfo: TIconInfo; Begin. // Capture the Desktop screen. DC := GetDC(GetDesktopWindow); ABitmap := TBitmap.Create; Try. ABitmap.Width := GetDeviceCaps(DC, HORZRES); ABitmap.Height := GetDeviceCaps(DC, VERTRES); // BitBlt on our bitmap. BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, DC, 0, 0, SRCCOPY); // Create temp. Icon. MyCursor := TIcon.Create; Try. // Retrieve Cursor info. CursorInfo := GetCursorInfo2; If CursorInfo.hCursor <> 0 then. Begin. MyCursor.Handle := CursorInfo.hCursor; // Get Hotspot information. GetIconInfo(CursorInfo.hCursor, IconInfo); // Draw the Cursor on our bitmap. ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot, CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor); End; Finally. // Clean up. MyCursor.ReleaseHandle; MyCursor.Free; End; Finally. ReleaseDC(GetDesktopWindow, DC); End; Result := ABitmap; End; // Example: Capture the screen and include the cursor. // Show the Screenshot in Image1. Procedure TForm1.Button1Click(Sender: TObject); Begin. Image1.Picture.Assign(CaptureScreen); End;

©Drkb::01843.

Взято с сайта: http://www.swissdelphicenter.ch.

Переходим на клиент-сервер (советы), на примере MS SQL Server.

Эта статья адресована прежде всего тем, кто работал с локальными базами и данных и теперь переходит на использование сервеных баз данных. Будет полезна так же и тем кто решил осваивать работу с базами данных сразу с серверных баз.

А собственно в чём проблема?

На первый взгляд подключаем сервер вместо того же парадокса и почти всё работает – так же можно бросить грид и посмотреть таблицу, так же можно выполнить селект. В чём же принципиальное отличие? Может не надо морочить голову и поменяв в BDE параметры Alias оставить всё как есть? Или просто заменить BDE компоненты на ADO? Ответ таков – что да, в простейшем случае всё работает, но не очень быстро даже при монопольном доступе и малых размерах таблиц, при увеличении размеров таблиц и подключении нескольких пользователей система начинает умирать, простые запросы выполнятся минутами, а то и часами… Вот тут-то и приходим к тому что простейшей заменой способа доступа к базе данных обойтись не получится.

Вот существенные моменты о которых надо помнить при разработке даже простейших систем клиент сервер, это ЧРЕЗВЫЧАЙНО важные моменты, их надо всегда учитывать!

1. Любые действия с базой данных происходят через сеть, поэтому программируя любые операции над базой данных програмист должен задать себе вопрос: а какой собственно сетевой трафик я создам этими действиями? Сколько мегабайт должно будет пройти через сетку в результате моих действий?

2. Приложение не работает с таблицами монопольно, другие клиенты тоже что-то делают с базой данных. Не блокируют ли мои действия другие программы? Если блокируют то как надолго? А действительно мне надо чтобы мои действия блокировали таблицы других клиентов?

3. Как именно будет мой запрос выполнятся сервером? Используйте индексы и ключи! Учтите что в отличие от локальных баз данных при отсутствии индекса SQL запрос будет выполнятся точно так же как и с индексом, никаких ошибок не будет, даже быстродействие на первых порах может не уменьшится, только потребление ресурсов процессора на сервере возрастёт – проблемы появятся позже… Всегда надо смотреть что именно сервер будет делать при запросе.

Помните что если вы не учли какой-то из этих моментов НИКАКИХ ошибок компиллятор вам не выдаст, а тестовое приложение на тестовых небольших базах данных в едином экземпляре будет работать великолепно, проблемы возникнут позже, когда програму начнут реально использовать.

Доступ к базам данных и производительность.

Если вы переходите на на клиент-сервер вам прийдётся отказаться от BDE. BDE – очень хорошая система для локальных баз данных и показывает отличную производительность на локальных таблицах при монопольном доступе. BDE вполне можно подключить чуть ли не к любым серверам баз данных, однако изначально разрабатывавшаяся с рассчётом на локальные базы данных BDE не даст вам хорошей производительности даже на небольших базах данных, при работе с большими базами данных и при большом количестве одновременных подключений BDE начинает работать исключительно медленно. Кроме того, Local SQL – диалект SQL для BDE довольно беден и многие сервера баз данных поддерживают несравненно более сложные и мощные диалекты SQL. ODBC – родной брат BDE в реализации MS – не блистал скоростью даже с локальными базами данных, не стоит его использовать и для на клиент-сервера. DAO – изначально был рассчитан на локальные базы от MS и с серверами не работает даже теоретически. Итого – из глобальных систем доступа к базам данных мы имеем ADO (OLE DB) и DBExpress. Я не специалист в DBExpress и не могу много сказать, но знакомство с документацией и отзывами пользователей привносит впечатление о достаточно слабой реализации и ограниченных возможностях. В то же время ADO в настоящее время пожалуй является одной из наиболее развитых и продвинутых систем. Кроме того не надо забывать что почти все производители серверов поставляют свои драйверы для доступа к базам данных.

Хм… Вы тут понаписывали, а я вот создал таблицу в парадоксе, подключился через BDE запустил Select, а потом сделал такую же таблицу в MS SQL Server, подключился через ADO запустил такой же Select – и получил что производительность парадокса на 2 порядка выше! В чём же прикол и на фига мне нужен тогда этот сервер и ADO?

Угу! Это действительно так! Но только в случае небольших локальных таблиц и при однопользовательском доступе! Если вы положите табличку в сетевую папку, сделаете её размером в сотню-другую тысяч записей, будете премежать Select с Update, и запустите десяток приложений с разных компьютеров которые будут это проделывать с этой табличкой одновременно, то получите картину производительности такую, что MS SQL Server + ADO будет работать почти с той же скоростью что и при монопольном доступе, а вот производительность парадокса при таком раскладе упадёт практически до нуля.

А может ну их эти драйвера! Может проще подключится как нибудь напрямую, через какие-нибудь API или вообще через сокеты? Зачем эти потери времени, дополнительные слой програм? Может я лучше всё сам и вручную сделаю лучше?

Должен разочаровать – совершенно бессмысленное занятие. Обычно никаких таких специальных API и не существует. Для подавляющего большинства баз данных единственным средством общения с внешним миром является SQL. И всё что делает драйвер – это передаёт этот SQL запрос от вашего приложения серверу, сервер внутри себя этот запрос компиллирует и выполняет, генерируя поток данных который передаётся клиенту. Обычно драйвера выполняют ещё и довольно сильное кэширование потока данных на клиенте и асинхронную передачу данных по запросу, что обеспечивает довольно значительное увеличение производительности, поэтому даже исхитрившись написать свой собственый драйвер к серверу вы вряд ли сможете достичь производительности коммерческих продуктов, во всяком случае это достаточно сложная и трудоёмкая задача.

Итак ADO. Что мне использовать?

Легче сказать что не использовать: категорически не рекомендуется использовать компонент TADOTable. Вся идеология клиент-сервера базируется на SQL запросах. В идеале НЕТ НИКАКИХ других способов взаимодействия с сервером кроме SQL запроса, поэтому TADOTable будет лишь эмулировать поведение TADOQuery, а в реале это приведёт к очень неоптимальным запросам и резкому падению производительности. Везде где это можно используйте SQL запросы.

Сетевой трафик.

Вернёмся к сетевому трафику. Вот чего не следует делать, так это посылать запросы типа.

Code: Select * From MyTable.

Запросы и параметры, или как избавится от многих проблем….

Где я? О чём вы?

Компонент TQuery имеет свойство Params:TParams, а компонент TADOQuery имеет свойство Parameters:TParameters. Эти объекты позволяют в уже готовом запросе подставить какие-либо значения. Делается это таким незамысловатым способом:

Code: {©Drkb v.3(2007): www.drkb.ru, ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}. ADOQuery1.Active:=False; ADOQuery1.SQL.text:='Select * From MyTable Where MyField=:prm'; ADOQuery1.Parameters.ParseSQL(ADOQuery1.SQL.text, true); ADOQuery1.Parameters.ParamByName('prm').Value:='чего-то там'; ADOQuery1.Active:=True;

Алгоритм шифрования TEA.

Немного модифицированный вариант для шифрования не особо критичных данных.

Code: //////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Unit Name : TEA. // * Purpose : Модуль шифрования по алгоритму TEA. // (Tiny Encryption Algorithm). // * Author : Александр (Rouse_) Багель. // * Version : 1.04. // * Home Page : http://rouse.drkb.ru. // **************************************************************************** // // Схема действия. // В функцию передается массив данных. // Генерируется уникальный 128 битный ключ для кодирования на основе GUID. // Вычисляется размер данных, они должны быть кратны четному. // кол-ву 32 битных блоков, недостающий обьем заполняется мусором. // Первые три байта занимает заголовок ETA. // В четвертую позицию данных добавляется значение указывающее объем мусора. // Производится кодирование ранее сгенерированным ключем. // Сам ключ кодируется внутренним ключем, делится на четыре части. // 128 битный ключ разделяется на четыре 32 битных блока. // Ключ добавляется в данные со сдвигом в любое место. // в следующем порядке 4-ый, 3-ий, 1-ый, 2-ой блоки. // На 14 ую позицию данных вставляется со сдвигом указатель на начало ключа. // Итого в закодированном буффере находится помимо основной. // еще и 21 байт служебной информации. // Для раскодирования все действи производится в обратном порядке. Unit TEA; {$Q-} // Отключаем INTEGER OVERFLOW. Interface. Uses. Windows, SysUtils, Classes; Const. Delta = $9E3779B9; // Смещение контрольной суммы ~ 32 бит. Header = 'ETA'; // Enhanced TEA. Var. _k0: DWORD = 0; // Главный 128 битный ключ (4 части по 32 бита). _k1: DWORD = 0; // Его нужно изменить на свой аналог... _k2: DWORD = 0; _k3: DWORD = 0; Type. PHash = ^THash; THash = array of Byte; Int256 = array [0..31] of Byte; Procedure EnCript(var S: THash); Procedure EnCryptStream(Stream: TStream); Function DeCript(var S: THash): Boolean; Function DeCriptStream(Stream: TStream): Boolean; Procedure SetDefaultKey; Procedure SetKey(Value: Int256); Implementation. // Установка ключа по умолчанию (DEMO - ключ). // ============================================================================= Procedure SetDefaultKey; Begin. _k0 := $982C98C1; // Главный 128 битный ключ (4 части по 32 бита). _k1 := $7F8F4D4B; // Его нужно изменить на свой аналог... _k2 := $BCAE3151; _k3 := $971BC789; End; // Установка рабочего ключа. // ============================================================================= Procedure SetKey(Value: Int256); Var. XorKey: DWORD; Begin. // Ну например вот так :). Move(Value[0], _k0, 4); Move(Value[4], XorKey, 4); _k0 := _k0 xor XorKey; Move(Value[4], _k1, 4); Move(Value[12], XorKey, 4); _k1 := _k1 xor XorKey; Move(Value[24], _k2, 4); Move(Value[20], XorKey, 4); _k2 := _k2 xor XorKey; Move(Value[16], _k3, 4); Move(Value[28], XorKey, 4); _k3 := _k3 xor XorKey; End; //////////////////////////////////////////////////////////////////////////////// // // ЧАСТЬ ПЕРВАЯ * * * КОДИРОВАНИЕ * * * Procedure EnCript(var S: THash); Var. InBuf, OutBuf, ResultBuf: THash; // Входной, выходной и результирующий буфера. Y, Z, Sum: LongWord; // Временные переменные для кодируемых блоков данных. K0, k1, k2 , k3: LongWord; // Текущий ключ для шифрования. I, A, Len: Integer; // Переменные для циклов. C: Byte; // Счетчик кол-ва мусора. Guid, Key: String; G: TGUID; Begin. // Проверка заданного ключа. If _k0 = 0 then SetDefaultKey; // Проверка размера данных. If Length(S) = 0 then Exit; Randomize; CreateGUID(G); // Генерируем ключик на основе GUID - а :). Guid := GUIDToString(G); For I := 1 to Length(Guid) do. If Guid[I] in ['0'..'9', 'A'..'F'] then. Key := Key + Guid[I]; K0 := StrToInt64('$' + Copy(Key, 1, 8)); K1 := StrToInt64('$' + Copy(Key, 9, 8)); K2 := StrToInt64('$' + Copy(Key, 17, 8)); K3 := StrToInt64('$' + Copy(Key, 25, 8)); C := 0; // Инициализируем счетчик дозаполнений. // Дозаполняем данные чтобы последний блок данных был равен 64 битам. While (Length(S) div 8) * 8 <> Length(S) do // 64 бита = 8 байтам :). Begin. Len := Length(S); Inc(Len); SetLength(S, Len); S[Len - 1] := Random(255); // Заполняем случайными данными. Inc(C); End; Len := Length(S); // Вычисляем размер кодируемого блока. SetLength(InBuf, Len); // Устанавливаем размер буферов. // Размер выходного буфера увеличен на 21 байт из-за. // 3 байта - заголовок ETA. // 1 байт - счетчик кол-ва мусора в конце буфера. // 16 байт - кодированный ключ - 4 Cardinal. // 1 байт - метка расположения кодированного ключа. Inc(Len, 21); SetLength(OutBuf, Len); SetLength(ResultBuf, Len); Inc(C);// Увеличим кол-во мусора для удаления самого поля счетчика. OutBuf[0] := Ord(Header[1]); // добавляем идентификатор. OutBuf[1] := Ord(Header[2]); OutBuf[2] := Ord(Header[3]); OutBuf[3] := C; // Добавляем счетчик мусора. Move(S[0], InBuf[0], Length(S));// Заполняем входной буфер данными. I := 0; While I < Len - 21 do // Непосредственно кодировка. Begin. Move(InBuf[I], Y, 4); // Берем первые 32 бита. Move(InBuf[I + 4], Z, 4); // Берем вторые 32 бита. // Кодируем. Sum := 0; For A := 0 to 31 do // 64 битный кодируемый блок (2 части по 32 бита). Begin. Inc(Sum, Delta); Inc(Y, ((Z shl 4) + k0) xor (Z + Sum) xor ((Z shr 5) + k1)); Inc(Z, ((Y shl 4) + k2) xor (Y + Sum) xor ((Y shr 5) + k3)); End; Move (Y, OutBuf[I + 4], 4); // Помещаем кодированные блоки в выходном буфер. Move (Z, OutBuf[I + 8], 4); Inc(I, 8); // Пропускаем обработанный блок, переходим к следующему. End; Sum := 0; For A := 0 to 31 do // Кодируем первые 2 части ключа внутренним ключем. Begin. Inc(sum,Delta); Inc(k0, ((k1 shl 4) + _k0) xor (k1 + Sum) xor ((k1 shr 5) + _k1)); Inc(k1, ((k0 shl 4) + _k2) xor (k0 + Sum) xor ((k0 shr 5) + _k3)); End; Sum := 0; For A := 0 to 31 do // Кодируем вторые 2 части ключа внутренним ключем. Begin. Inc(Sum, Delta); Inc(k2, ((k3 shl 4) + _k0) xor (k3 + Sum) xor ((k3 shr 5) + _k1)); Inc(k3, ((k2 shl 4) + _k2) xor (k2 + Sum) xor ((k2 shr 5) + _k3)); End; // Определяем позицию размещения ключа в блоке данных. Randomize; If Len < 255 then. I := Len. Else. I := 255; Repeat. I := Random(I); If I < 4 then I := 4; Until I < Len - 16; // <- исправление глюка с шифрованием маленьких блоков данных. // Смещаем данные освобождая место для четырех. // частей ключа. Move(OutBuf[0], ResultBuf[0], I); Move(OutBuf[I], ResultBuf[I + 16], Len - I - 17); // Разбиваем четвертую четверть ключа на 4 восьмибитных части. ResultBuf[I] := Byte(k3 shr 24); ResultBuf[I + 1] := Byte(k3 shr 16); ResultBuf[I + 2] := Byte(k3 shr 8); ResultBuf[I + 3] := Byte(k3); // Разбиваем третью четверть ключа на 4 восьмибитных части. ResultBuf[I + 4] := Byte(k2 shr 24); ResultBuf[I + 5] := Byte(k2 shr 16); ResultBuf[I + 6] := Byte(k2 shr 8); ResultBuf[I + 7] := Byte(k2); // Разбиваем первую четверть ключа на 4 восьмибитных части. ResultBuf[I + 8] := Byte(k0 shr 24); ResultBuf[I + 9] := Byte(k0 shr 16); ResultBuf[I + 10] := Byte(k0 shr 8); ResultBuf[I + 11] := Byte(k0); // Разбиваем вторую четверть ключа на 4 восьмибитных части. ResultBuf[I + 12] := Byte(k1 shr 24); ResultBuf[I + 13] := Byte(k1 shr 16); ResultBuf[I + 14] := Byte(k1 shr 8); ResultBuf[I + 15] := Byte(k1); // Сдвигаем данные с 14 позиции на одну вправо для метки. // (буфер начинается с нуля). For A := Len - 1 downto 14 do. ResultBuf[A] := ResultBuf[A - 1]; // Помещаем метку начала ключа (14-й байт). ResultBuf[13] := I; S := ResultBuf; End; // Функция кодирует стрим с текущей позиции и до конца. // Результат помещается в текущую позицию. Размеры стрима корректируются. // ============================================================================= Procedure EnCryptStream(Stream: TStream); Var. Template: THash; Position: Int64; Begin. If Stream = nil then. Raise Exception.Create('Empty stream.'); Position := Stream.Position; SetLength(Template, Stream.Size - Position); Stream.Read(Template[0], Length(Template)); EnCript(Template); Stream.Size := Position + Length(Template); Stream.Position := Position; Stream.Write(Template[0], Length(Template)); End; //////////////////////////////////////////////////////////////////////////////// // // ЧАСТЬ ВТОРАЯ * * * ДЕКОДИРОВАНИЕ * * * Function DeCript (var S: THash): Boolean; Var. InBuf, OutBuf, ResultBuf: THash; // Входной, выходной и результирующий буфера. Y , Z, Sum: LongWord; // Временные переменные для кодируемых блоков данных. K0, k1, k2, k3: LongWord; // Текущий ключ для шифрования. I, A, Len: Integer; // Переменные для циклов. AHeader: String; Begin. Result := False; // Проверка заданного ключа. If _k0 = 0 then SetDefaultKey; Len := Length(S); // Вычисляем размер декодируемого блока. // Проверка размера. If Len < 27 then Exit; If Len <> (((Len - 21) div 8) * 8) + 21 then Exit; // Проверка заголовка. AHeader := Char(S[0]) + Char(S[1]) + Char(S[2]); If AHeader <> Header then Exit; // Проверка позиции ключа. If not(S[13] in [4..255]) then Exit; If S[13] + 16 > Len then Exit; // Проверка счетчика мусора. If S[3] > 8 then Exit; SetLength(InBuf, Len); // Устанавливаем размер буферов. Move(S[0], InBuf[0], Len);// Заполняем входной буфер данными. I := InBuf[13]; // Узнаем начальную позицию ключа. // Удаляем метку на начало ключа. For A := 13 to Len - 2 do. Begin. InBuf[A] := InBuf[A + 1]; InBuf[A + 1] := 0; End; Dec(Len); // Извлекаем ключ. K3 :=(InBuf[I + 3] or (InBuf[I + 2] shl 8) or (InBuf[I + 1] shl 16) or (InBuf[I] shl 24)); K2 :=(InBuf[I + 7] or (InBuf[I + 6] shl 8) or (InBuf[I + 5] shl 16) or (InBuf[I + 4] shl 24)); K0 :=(InBuf[I + 11] or (InBuf[I + 10] shl 8) or (InBuf[I + 9] shl 16) or (InBuf[I + 8] shl 24)); K1 :=(InBuf[I + 15] or (InBuf[I + 14] shl 8) or (InBuf[I + 13] shl 16) or (InBuf[I + 12] shl 24)); // Удаляем ключ из блока данных. For A := I + 16 to Len do. Begin. InBuf[A - 16] := InBuf[A]; InBuf[A] := 0; End; SetLength(OutBuf, Len); ZeroMemory(OutBuf, Len); Dec(Len, 16); // Удаляем размер ключа. // Декодируем первые две части ключа. Sum := Delta shl 5; For A := 0 to 31 do. Begin. Dec(k1, ((k0 shl 4) + _k2) xor (k0 + Sum) xor ((k0 shr 5) + _k3)); Dec(k0, ((k1 shl 4) + _k0) xor (k1 + Sum) xor ((k1 shr 5) + _k1)); Dec(Sum, Delta); End; // Декодируем вторые две части ключа. Sum := Delta shl 5; For A := 0 to 31 do. Begin. Dec(k3, ((k2 shl 4) + _k2) xor (k2 + Sum) xor ((k2 shr 5) + _k3)); Dec(k2, ((k3 shl 4) + _k0) xor (k3 + Sum) xor ((k3 shr 5) + _k1)); Dec(Sum, Delta); End; I := 0; Dec(Len); // Удяляем из размера место счетчика мусора. Dec(Len, 3); // Удаляем из размера заголовок ETA. While I < Len do // Непосредственно декодировка. Begin. Move(InBuf[I + 4], Y, 4); // Берем первые 32 бита. Move(InBuf[I + 8], Z, 4); // Берем вторые 32 бита. // Декодируем. Sum := Delta shl 5; For A := 0 to 31 do // 64 битный кодируемый блок (2 части по 32 бита). Begin. Dec(Z, ((Y shl 4) + k2) xor (Y + Sum) xor ((Y shr 5) + k3)); Dec(Y, ((Z shl 4) + k0) xor (Z + Sum) xor ((Z shr 5) + k1)); Dec(Sum, Delta); End; Move(Y, OutBuf[I], 4); // Запоминаем кодированные блоки в выходном буфере. Move(Z, OutBuf[I + 4], 4); Inc(I, 8); // Пропускаем обработанный блок, переходим к следующему. End; // Отрезаем мусор (-1 потому что место для счетчика уже удалено из Len). Len := Len - (InBuf[3] - 1); SetLength(ResultBuf, Len); Move(OutBuf[0], ResultBuf[0], Len); // Выводим текст из выходного буфера. S := ResultBuf; Result := True; End; // Функция декодирует стрим с текущей позиции и до конца. // Результат помещается в текущую позицию. Размеры стрима корректируются. // ============================================================================= Function DeCriptStream(Stream: TStream): Boolean; Var. Template: THash; Position: Int64; Begin. If Stream = nil then. Raise Exception.Create('Empty stream.'); Position := Stream.Position; SetLength(Template, Stream.Size - Position); Stream.Read(Template[0], Length(Template)); Result := DeCript(Template); Stream.Size := Position + Length(Template); Stream.Position := Position; Stream.Write(Template[0], Length(Template)); End; End.

Алгоритм поиска всех уникальных слов в файле.

Code: //////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Unit Name : Dictionary. // * Purpose : Набор классов для работы с индексированным списком поиска. // * Author : Александр Багель. // * Version : 1.00. // **************************************************************************** // Unit Dictionary; Interface. Uses. Windows, Classes, SysUtils{, FullTextGetter}; Type. // Класс отвечающий за создание словаря уникальных слов. TDictionaryFounder = class. Private. FDict: TList; FDictMem: array of String; FDictMemCount: Integer; Protected. Function GetPos(const Value: String): Integer; virtual; Procedure Insert(Value: String; Position: Integer); virtual; Function Prepare(const Value: String): String; virtual; Public. Constructor Create; Destructor Destroy; override; Procedure AddData(Value: String); //overload; // procedure AddData(ObjText: IFullTextGetter); overload; Procedure SaveToStream(var AStream: TMemoryStream); End; // Класс осуществляющий поиск в словаре. // полученном от TDictionaryFounder. TDictionaryFinder = class. Private. FDict: array of ShortString; FDictLength: Cardinal; Protected. Function GetPos(const Value: ShortString; Const SubStr: Boolean = False): Boolean; virtual; Public. Destructor Destroy; override; Procedure LoadFromStream(const AStream: TMemoryStream); Function Find(const Value: String; Const SubStr: Boolean = False): Boolean; End; Implementation. { TDictionaryFounder }. // // Добавление информации для построения массива индексов. // ============================================================================= Procedure TDictionaryFounder.AddData(Value: String); Var. Tmp: String; Position, I: Integer; S: TStringList; Begin. Value := Prepare(Value); S := TStringList.Create; Try. S.Text := Value; For I := 0 to S.Count - 1 do. Begin. Tmp := S[I]; If Tmp = '' then Continue; If FDict.Count = 0 then. Insert(Tmp, 0). Else. Begin. Position := GetPos(Tmp); If (Position >= 0) then. If FDict.Count > Position then. Begin. If String(FDict.Items[Position]) <> Tmp then. Insert(Tmp, Position); End. Else. Insert(Tmp, Position); End; End; Finally. S.Free; End; End; // // Добавление информации для построения массива индексов. // Информация приходит из интерфейса. // ============================================================================= {procedure TDictionaryFounder.AddData(ObjText: IFullTextGetter); Var. S: String; Begin. If ObjText = nil then. Raise Exception.Create('IFullTextGetter is empty.'); S := ObjText.GetText; AddData(S); End; }. Constructor TDictionaryFounder.Create; Begin. FDict := TList.Create; End; Destructor TDictionaryFounder.Destroy; Begin. FDict.Free; FDictMemCount := 0; SetLength(FDictMem, FDictMemCount); Inherited; End; // // Возвращает номер позиции где находится слово, или должно находится... // Поиск методом половинного деления... // ============================================================================= Function TDictionaryFounder.GetPos(const Value: String): Integer; Var. FLeft, FRight, FCurrent: Cardinal; Begin. If FDict.Count = 0 then. Begin. Result := 0; Exit; End; FLeft := 0; FRight := FDict.Count - 1; FCurrent := (FRight + FLeft) div 2; If String(FDict.Items[FLeft]) > Value then. Begin. Result := 0; Exit; End; If String(FDict.Items[FRight]) < Value then. Begin. Result := FRight + 1; Exit; End; Repeat. If String(FDict.Items[FCurrent]) = Value then. Begin. Result := FCurrent; Exit; End; If String(FDict.Items[FCurrent]) < Value then. FLeft := FCurrent. Else. FRight := FCurrent; FCurrent := (FRight + FLeft) div 2; Until FLeft = FCurrent; If String(FDict.Items[FCurrent]) < Value then Inc(FCurrent); Result := FCurrent; End; // // Добавление нового индекса в массив индексов. // ============================================================================= Procedure TDictionaryFounder.Insert(Value: String; Position: Integer); Begin. If FDictMemCount < FDict.Count + 1 then. Begin. Inc(FDictMemCount, FDict.Count + 1); SetLength(FDictMem, FDictMemCount); End; FDictMem[FDict.Count] := Value; FDict.Insert(Position, @FDictMem[FDict.Count][1]); End; // // Сохранение массива индексов в поток. // ============================================================================= Procedure TDictionaryFounder.SaveToStream(var AStream: TMemoryStream); Var. I: Integer; S: PChar; TmpS: TStringList; Begin. If AStream = nil then Exit; TmpS := TStringList.Create; Try. For I := 0 to FDict.Count - 1 do. Begin. S := FDict.Items[I]; TmpS.Add(S); End; AStream.Position := 0; AStream.Size := Length(TmpS.Text); AStream.Write(TmpS.Text[1], Length(TmpS.Text)); AStream.Position := 0; Finally. TmpS.Free; End; End; // // Подготовка данных к обработке... // Удаляются все не буквенные символы, каждое слово начинется с новой строки... // ============================================================================= Function TDictionaryFounder.Prepare(const Value: String): String; Var. I: Integer; Len: Cardinal; C: PAnsiChar; LastEnter: Boolean; Begin. SetLength(Result, Length(Value) * 2); Len := 0; LastEnter := False; For I := 1 to Length(Value) do. Begin. C := CharLower(@Value[I]); If C^ in ['a'..'z', 'а'..'я'] then. Begin. Inc(Len); Result[Len] := C^; LastEnter := False; End. Else. If not LastEnter then. Begin. Inc(Len); Result[Len] := #13; Inc(Len); Result[Len] := #10; LastEnter := True; End; End; SetLength(Result, Len); End; { TDictionaryFinder }. Destructor TDictionaryFinder.Destroy; Begin. FDictLength := 0; SetLength(FDict, FDictLength); Inherited; End; // // Поиск введенных слов... // ============================================================================= Function TDictionaryFinder.Find(const Value: String; Const SubStr: Boolean = False): Boolean; Var. S: TStringList; I: Integer; Begin. Result := False; If Value = '' then Exit; S := TStringList.Create; Try. S.Text := StringReplace(Value, ' ', #13#10, [rfReplaceAll]); S.Text := AnsiLowerCase(S.Text); If S.Count = 0 then Exit; For I := 0 to S.Count - 1 do. Begin. Result := GetPos(S.Strings[I], SubStr); If not Result then Exit; End; Finally. S.Free; End; End; // // Поиск каждого слова в массиве индексов. // ============================================================================= Function TDictionaryFinder.GetPos(const Value: ShortString; Const SubStr: Boolean = False): Boolean; Var. FLeft, FRight, FCurrent, I: Cardinal; Begin. Result := False; If SubStr then. Begin. For I := 0 to FDictLength - 1 do. If Pos(Value, FDict[I]) > 0 then. Begin. Result := True; Exit; End; End. Else. Begin. If FDictLength = 0 then Exit; FLeft := 0; FRight := FDictLength - 1; FCurrent := (FRight + FLeft) div 2; If FDict[FLeft] > Value then Exit; If FDict[FRight] < Value then Exit; If FDict[FLeft] = Value then. Begin. Result := True; Exit; End; If FDict[FRight] = Value then. Begin. Result := True; Exit; End; Repeat. If FDict[FCurrent] = Value then. Begin. Result := True; Exit; End; If FDict[FCurrent] < Value then. FLeft := FCurrent. Else. FRight := FCurrent; FCurrent := (FRight + FLeft) div 2; Until FLeft = FCurrent; End; End; // // Загрузка массива индексов из потока. // ============================================================================= Procedure TDictionaryFinder.LoadFromStream(const AStream: TMemoryStream); Var. S: TStringList; I: Integer; Begin. S := TStringList.Create; Try. AStream.Position := 0; S.LoadFromStream(AStream); FDictLength := S.Count; If FDictLength = 0 then Exit; SetLength(FDict, FDictLength); For I := 0 to FDictLength - 1 do. FDict[I] := S.Strings[I]; Finally. S.Free; End; End; End.

Как узнать форма активна или нет?

Code: Type. //... Private. { Private declarations }. Procedure WMNCACTIVATE(var M: TWMNCACTIVATE); message WM_NCACTIVATE; End; Implementation. //... Procedure TForm1.WMNCACTIVATE(var M: TWMNCACTIVATE); Begin. Inherited; If M.Active then. Caption:='Form active' Else caption:='Form not active' ; End;

Получение IP адресов всех компьютеров в рабочей группе.

Code: Var. Computer: array[1..500] of string[25]; ComputerCount: Integer; Procedure FindAllComputers(Workgroup: string); Var. EnumHandle: THandle; WorkgroupRS: TNetResource; Buf: array[1..500] of TNetResource; BufSize: Integer; Entries: Integer; Result: Integer; Begin. ComputerCount := 0; Workgroup := Workgroup + #0; FillChar(WorkgroupRS, SizeOf(WorkgroupRS), 0); With WorkgroupRS do. Begin. DwScope := 2; DwType := 3; DwDisplayType := 1; DwUsage := 2; LpRemoteName := @Workgroup[1]; End; WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle); Repeat. Entries := 1; BufSize := SizeOf(Buf); Result := WNetEnumResource(EnumHandle, Entries, @Buf, BufSize); If (Result = NO_ERROR) and (Entries = 1) then. Begin. Inc(ComputerCount); Computer[ComputerCount] := StrPas(Buf[1].lpRemoteName); End; Until (Entries <> 1) or (Result <> NO_ERROR); WNetCloseEnum(EnumHandle); End; { Find All Computers }.

Демонстрационная программа сканирования сети.

Code: //////////////////////////////////////////////////////////////////////////////// // // Демонстрационная программа сканирования сети на основе. // WNetOpenEnum, WNetEnumResource, WNetCloseEnum. // // Автор: Александр (Rouse_) Багель. // mailto:rouse79@yandex.ru. // // Специально для форумов Мастера Дельфи и Исходники.RU. // http://www.delphimaster.ru. // http://forum.sources.ru. // Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Winsock, ImgList, ShellAPI; Const. STR_START = 'Начать сканирование'; STR_STOP = 'Остановить сканирование'; STR_STARTED = ' Идет сканирование ...'; STR_STOPPED = ' Сканирование завершено ...'; STR_END = ' Завершение потока ...'; STR_FIELD = ' Поле не выбрано ...'; Type. TDemoThread = class(TThread). Private. TreeNetWrk: TTreeNode; TreeDomain: TTreeNode; TreeServer: TTreeNode; TreeShares: TTreeNode; Param_dwType: Byte; Param_dwDisplayType: Byte; Param_lpRemoteName: String; Param_lpIP: String; Protected. Procedure Execute; override; Procedure Scan(Res: TNetResource; Root: boolean); Procedure AddElement; Procedure Stop; End; TForm1 = class(TForm). Button1: TButton; TreeView1: TTreeView; StatusBar1: TStatusBar; ImageList1: TImageList; Procedure Button1Click(Sender: TObject); Procedure TreeView1Click(Sender: TObject); Procedure FormCreate(Sender: TObject); Procedure TreeView1DblClick(Sender: TObject); Private. Thread: TDemoThread; End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Function GetIPAddress(NetworkName: String): String; Var. Error: DWORD; HostEntry: PHostEnt; Data: WSAData; Address: In_Addr; Begin. Delete(NetworkName, 1, 2); Error:=WSAStartup(MakeWord(1, 1), Data); If Error = 0 then. Begin. HostEntry:=gethostbyname(PChar(NetworkName)); Error:=GetLastError; If Error = 0 then. Begin. Address:=PInAddr(HostEntry^.h_addr_list^)^; Result:=inet_ntoa(Address); End. Else. Result:='Unknown'; End. Else. Result:='Error'; WSACleanup; End; { TDemoThread }. Procedure TDemoThread.Execute; Var. R:TNetResource; Begin. Inherited; Priority := tpIdle; FreeOnTerminate := True; Resume; Scan(R, True); TreeDomain := nil; TreeServer := nil; Synchronize(Stop); End; Procedure TDemoThread.Scan(Res: TNetResource; Root: boolean); Var. HEnum: Cardinal; NrResource: array[0..512] of TNetResource; DwSize: DWORD; NumEntries: DWORD; I: DWORD; DwResult: DWORD; Begin. If Root then. DwResult := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, nil, hEnum). Else. DwResult := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Res, hEnum); If dwResult = NO_ERROR then. Begin. DwSize := SizeOf(nrResource); NumEntries := DWORD(-1); // ERROR_NO_MORE_ITEMS. If WNetEnumResource(hEnum, numEntries, @nrResource, dwSize) = NO_ERROR then. Begin. For i := 0 to numEntries - 1 do. Begin. If Terminated then Break; With nrResource[i] do. Begin. Param_dwType := dwType; Param_dwDisplayType := dwDisplayType; Param_lpRemoteName := lpRemoteName; If Param_dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then. Param_lpIP := GetIPAddress(Param_lpRemoteName); End; If Assigned(nrResource[i].lpRemoteName) then. Synchronize(AddElement); Scan(nrResource[i], false); End; WNetCloseEnum(hEnum); End; End; End; Procedure TDemoThread.AddElement; Begin. Application.ProcessMessages; Case Param_dwDisplayType of. RESOURCEDISPLAYTYPE_NETWORK: Begin. TreeNetWrk := Form1.TreeView1.Items.Add(nil, Param_lpRemoteName); TreeNetWrk.StateIndex := 1; End; RESOURCEDISPLAYTYPE_DOMAIN: Begin. TreeDomain := Form1.TreeView1.Items.AddChild(TreeNetWrk, Param_lpRemoteName); TreeDomain.StateIndex := 2; End; RESOURCEDISPLAYTYPE_SERVER: Begin. TreeServer := Form1.TreeView1.Items.AddChild(TreeDomain, Param_lpRemoteName + ' IP: ' + Param_lpIP); TreeServer.StateIndex := 3; End; RESOURCEDISPLAYTYPE_SHARE: Begin. TreeShares := Form1.TreeView1.Items.AddChild(TreeServer, Param_lpRemoteName); TreeShares.StateIndex := 3 + Param_dwType; End; End; End; Procedure TDemoThread.Stop; Begin. Form1.StatusBar1.Panels[1].Text := STR_STOPPED; Form1.Button1.Caption := STR_START; Form1.Button1.Enabled := True; Form1.Tag := 0; End; { TForm1 }. Procedure TForm1.FormCreate(Sender: TObject); Begin. Tag := 0; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Tag := Tag + 1; If (Tag mod 2) = 1 then. Begin. TreeView1.Items.Clear; StatusBar1.Panels[1].Text := STR_STARTED; Button1.Caption := STR_STOP; Thread := TDemoThread.Create(False); End. Else. Begin. StatusBar1.Panels[1].Text := STR_END; Button1.Enabled := False; Thread.Terminate; End; End; Procedure TForm1.TreeView1Click(Sender: TObject); Begin. If Assigned(TreeView1.Selected) then. StatusBar1.Panels[0].Text := ' ' + TreeView1.Selected.Text. Else. StatusBar1.Panels[0].Text := STR_FIELD; End; Procedure TForm1.TreeView1DblClick(Sender: TObject); Var. Str: String; Begin. If Assigned(TreeView1.Selected) then. Begin. Str := TreeView1.Selected.Text; If Copy(Str, 1, 2) <> '\\' then Exit; If Pos(' IP:', Str) <> 0 then. ShellExecute(Handle, 'explore', PChar(Copy(Str, 1, Pos(' IP:', Str))), nil, nil, SW_SHOW). Else. ShellExecute(Handle, 'explore', PChar(Str), nil, nil, SW_SHOW); End; End; End.

Демонстрационная программа получения информации о компьютере по IP.

Code: // Демонстрационная программа получения информации о компьютере. // на основе IP адреса. // Автор: Александр (Rouse_) Багель. // 30 декабря 2004. // ============================================================= // Специально для FAQ сайта Мастера Дельфи и Исходники.RU. // http://www.delphimaster.ru. // http://forum.sources.ru. // Windows9x, Windows Millenium не поддерживются. // Примечание: Я не любитель венгерской нотации в отношении переменных. // и давно выработал собственный, удобный для меня, стиль написания кода, // (да и начальство не против :) поэтому не судить строго ;). Unit uMain; {$DEFINE RUS}. Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, CommCtrl, Winsock; Const. {$IFDEF RUS}. RES_UNKNOWN = 'Неизвестно'; RES_IP = 'IP адрес: '; RES_CMP = 'Имя компьютера: '; RES_USR = 'Имя пользователя: '; RES_DOM = 'Домен: '; RES_SER = 'Сервер домена: '; RES_COM = 'Коментарий: '; RES_PROV = 'Провайдер: '; RES_GRP = 'Группы: '; RES_MAC = 'MAC адресс: '; RES_SHARES = 'Доступные ресурсы: '; RES_TIME = 'Времени затрачено: '; RES_COM_NO = 'Отсутствует'; {$ELSE}. RES_UNKNOWN = 'Unknown'; RES_IP = 'IP adress: '; RES_CMP = 'Computer name: '; RES_USR = 'User name: '; RES_DOM = 'Domen: '; RES_SER = 'Domen server: '; RES_COM = 'Comment: '; RES_PROV = 'Provider: '; RES_GRP = 'Groups: '; RES_MAC = 'MAC adress: '; RES_SHARES = 'Available shares: '; RES_TIME = 'Expended time: '; RES_COM_NO = 'Absent'; {$ENDIF}. WSA_TYPE = $101; //$202; // Для работы с ARP (Address Resolution Protocol) таблицей. IPHLPAPI = 'IPHLPAPI.DLL'; MAX_ADAPTER_ADDRESS_LENGTH = 7; Type. LMSTR = LPWSTR; NET_API_STATUS = DWORD; // Следующие три типа используются для работы с Iphlpapi.dll. // Выдрал из Iphlpapi.h. // Так будет выглядеть МАС. TMacAddress = array[0..MAX_ADAPTER_ADDRESS_LENGTH] of byte; // Это структура для единичного запроса. TMibIPNetRow = packed record. DwIndex : DWORD; DwPhysAddrLen : DWORD; BPhysAddr : TMACAddress; // Вот здесь и лежит МАС!!! DwAddr : DWORD; DwType : DWORD; End; // Как и в статье не будем выделять память динамически, // а сразу создадим массив... (хотя, чесно говоря, это не правильно, // но я иду простым путем :). TMibIPNetRowArray = array [0..512] of TMibIPNetRow; // А это, как и во всей библиотеке, такая вот... // запрашиваемая структура (в моей статье уже видел пример...). PTMibIPNetTable = ^TMibIPNetTable; TMibIPNetTable = packed record. DwNumEntries : DWORD; Table: TMibIPNetRowArray; End; // Структура для перечисления залогиненных пользователей. _WKSTA_USER_INFO_1 = record. Wkui1_username: LPWSTR; Wkui1_logon_domain: LPWSTR; Wkui1_oth_domains: LPWSTR; Wkui1_logon_server: LPWSTR; End; WKSTA_USER_INFO_1 = _WKSTA_USER_INFO_1; PWKSTA_USER_INFO_1 = ^_WKSTA_USER_INFO_1; LPWKSTA_USER_INFO_1 = ^_WKSTA_USER_INFO_1; // Структура для определения принадлежности пользователя к группам. PGroupUsersInfo0 = ^_GROUP_USERS_INFO_0; _GROUP_USERS_INFO_0 = packed record. Grui0_name: LPWSTR; End; TGroupUsersInfo0 = _GROUP_USERS_INFO_0; GROUP_USERS_INFO_0 = _GROUP_USERS_INFO_0; // Структура для отределения доступных сетевых ресурсов. PSHARE_INFO_1 = ^SHARE_INFO_1; _SHARE_INFO_1 = record. Shi1_netname: LMSTR; Shi1_type: DWORD; Shi1_remark: LMSTR; End; SHARE_INFO_1 = _SHARE_INFO_1; TShareInfo1 = SHARE_INFO_1; PShareInfo1 = PSHARE_INFO_1; TMainForm = class(TForm). GbIP: TGroupBox; GbInfo: TGroupBox; MemInfo: TMemo; BtnGetInfo: TButton; Procedure btnGetInfoClick(Sender: TObject); Procedure FormCreate(Sender: TObject); Private. IP, Font: Integer; // Это переменные для работы с. EdIP: HWND; // WC_IPADDRESS классом. Function GetNameFromIP(const IP: String): String; Function GetUsers(const CompName: String): String; Function GetDomain(const CompName, Provider: String): String; Function GetComment(CompName, Provider: String): String; Function GetProvider(const CompName: String): String; Function GetMacFromIP(const IP: String): String; Function GetDomainServer(const DomainName: String): String; Function GetGroups(DomainServer: String; UserName: String): String; Function GetShares(const CompName: String): String; End; // Объявим функции, так как их объявлений нет в Дельфи. // Здесь идет статическая загрузка библиотек, только потому, // что данные функции есть во всех системах, начиная с W95... {$EXTERNALSYM WNetGetResourceInformation}. Function WNetGetResourceInformation(lpNetResource: PNetResource; LpBuffer: Pointer; var lpcbBuffer: DWORD; lplpSystem: Pointer): DWORD; stdcall; {$EXTERNALSYM GetIpNetTable}. Function GetIpNetTable(pIpNetTable: PTMibIPNetTable; PdwSize: PULONG; bOrder: Boolean): DWORD; stdcall; Function WNetGetResourceInformation; external mpr name 'WNetGetResourceInformationA'; Function GetIpNetTable; external IPHLPAPI name 'GetIpNetTable'; Function NetGetAnyDCName(servername: LPCWSTR; domainname: LPCWSTR; Bufptr: Pointer): Cardinal; Stdcall; external 'netapi32.dll'; Function NetShareEnum(servername: LMSTR; level: DWORD; var bufptr: Pointer; Prefmaxlen: DWORD; entriesread, totalentries, Resume_handle: LPDWORD): NET_API_STATUS; stdcall; external 'Netapi32.dll'; Function NetApiBufferFree(buffer: Pointer): Cardinal; Stdcall; external 'netapi32.dll'; Function NetWkstaUserEnum(ServerName: LPCWSTR; Level: DWORD; BufPtr: Pointer; PrefMaxLen: DWORD; EntriesRead: LPDWORD; TotalEntries: LPDWORD; ResumeHandle: LPDWORD): LongInt; stdcall; external 'netapi32.dll'; Function NetUserGetGroups(ServerName: LPCWSTR; UserName: LPCWSTR; Level: DWORD; Bufptr: Pointer; Prefmaxlen: DWORD; Var entriesread: DWORD; Var totalentries: DWORD): LongInt; stdcall; external 'netapi32.dll'; Var. MainForm: TMainForm; Implementation. {$R *.dfm}. // Для ввода IP адреса будем использовать класс WC_IPADDRESS. // именно для этого и предназначеный... Procedure TMainForm.FormCreate(Sender: TObject); Begin. // Зададим первоначальный IP адрес (это адрес моей машины). IP := MAKEIPADDRESS(192, 168, 2, 108); // Инициализируем дополнительные классы библиотеки ComCtl32.dll. InitCommonControl(ICC_INTERNET_CLASSES); // Создадим само окошко (предком ему будет gbIP). EdIP:= CreateWindow(WC_IPADDRESS, nil, WS_CHILD or WS_VISIBLE, 6, 16, 100, 21, gbIP.Handle, 0, hInstance, nil); // Укажем ему какой IP показывать. SendMessage(edIP, IPM_SETADDRESS, 0, IP); // Подберем нужный шрифтик для него... Font := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif'); // и скажем, чтоб он был с этим шрифтом (а то больно уж неказистый...). SendMessage(edIP, WM_SETFONT, Font, 0); End; // Ну это короче понятно... Procedure TMainForm.btnGetInfoClick(Sender: TObject); Var. TmpCompName, TmpProvider, TmpGroup, TmpUser, TmpServer: String; Time: Cardinal; IPStr: String; Begin. Time := GetTickCount; // Засечем время... // Узнаем, что за адрес введен... (он появится в IP). SendMessage(edIP, IPM_GETADDRESS, 0, Longint(PDWORD(@IP))); // Преобразуем эту абракадабру в нормальный "Dotted IP". IPStr := IntToStr(FIRST_IPADDRESS(IP)); IPStr := IPStr + '.' + IntToStr(SECOND_IPADDRESS(IP)); IPStr := IPStr + '.' + IntToStr(THIRD_IPADDRESS(IP)); IPStr := IPStr + '.' + IntToStr(FOURTH_IPADDRESS(IP)); // Ну и начнем работать... With memInfo, memInfo.Lines do // Вывод информации. Begin. Clear; // Очищаем экран. Refresh; // Ну и обновляем... // (при вызове первой функции может не обновиться). Add(RES_IP + IPStr); // Выводим IP адрес. TmpCompName := GetNameFromIP(IPStr); If TmpCompName = RES_UNKNOWN then Exit; Add(RES_CMP + TmpCompName); // Выводим имя компьютера. TmpUser := GetUsers(IPStr); Add(RES_USR + TmpUser); // Выводим имя пользователя. TmpProvider := GetProvider(TmpCompName); Add(RES_PROV + TmpProvider); // Выводим провайдера. Add(RES_COM + GetComment(TmpCompName, TmpProvider)); // Выводим комментарий к ресурсу. TmpGroup := GetDomain(TmpCompName, TmpProvider); Add(RES_DOM + TmpGroup); // Выводим группу. TmpServer := GetDomainServer(TmpGroup); If TmpServer <> '' then. Begin. Add(RES_SER + TmpServer); // Выводим имя сервера. Add(RES_GRP + GetGroups(TmpServer, TmpUser)); // Выводим группы домена в которые входит пользователь. End; Add(RES_SHARES + GetShares(TmpCompName)); // Выводим список доступных ресурсов. Add(RES_MAC + GetMacFromIP(IPStr)); // Выводим МАС адрес. Add(RES_TIME + IntToStr(GetTickCount - Time)); // Сколько времени затрачено. End; End; // Вообщето желательно запускать данную функцию отдельным потоком. // Поясню: при отсутствии компьютера с заданным IP программа будет. // ожидать выполнения gethostbyaddr и на это время подвиснет. Function TMainForm.GetNameFromIP(const IP: String): String; Var. WSA: TWSAData; Host: PHostEnt; Addr: Integer; Err: Integer; Begin. Result := RES_UNKNOWN; Err := WSAStartup(WSA_TYPE, WSA); If Err <> 0 then // Лучше пользоваться такой конструкцией, Begin // чтобы в случае ошибки можно было увидеть ее код. ShowMessage(SysErrorMessage(GetLastError)); Exit; End; Try. Addr := inet_addr(PChar(IP)); If Addr = INADDR_NONE then. Begin. ShowMessage(SysErrorMessage(GetLastError)); WSACleanup; Exit; End; Host := gethostbyaddr(@Addr, SizeOf(Addr), PF_INET); If Assigned(Host) then // Обязательная проверка, в противном случае, при. Result := Host.h_name // отсутствии компьютера с заданым IP, получим AV. Else. ShowMessage(SysErrorMessage(GetLastError)); Finally. WSACleanup; End; End; // Перечисляем всех залогиненных на машине пользователей. // начинаем перечисления со второго пользователя, потомчто. // первым будет "имя компьютера"$ Function TMainForm.GetUsers(const CompName: String): String; Var. Buffer, tmpBuffer: Pointer; PrefMaxLen : DWORD; Resume_Handle : DWORD; EntriesRead : DWORD; TotalEntries : DWORD; I, Size : Integer; PSrvr : PWideChar; Begin. PSrvr := nil; Try. // Переводим имя компьютера типа PWideChar. Size := Length(CompName); GetMem(PSrvr, Size * SizeOf(WideChar) + 1); StringToWideChar(CompName, PSrvr, Size + 1); PrefMaxLen := DWORD(-1); EntriesRead := 0; TotalEntries := 0; Resume_Handle := 0; Buffer := nil; // Получаем список пользователей на компьютере из PSrvr. If NetWkstaUserEnum( PSrvr, 1, @Buffer, PrefMaxLen, @EntriesRead, @TotalEntries, @Resume_Handle) = S_OK then. Begin. TmpBuffer := Pointer(DWORD(Buffer) + SizeOf(WKSTA_USER_INFO_1)); For I := 1 to TotalEntries - 1 do. Begin. Result := Result + WKSTA_USER_INFO_1(tmpBuffer^).wkui1_username + ', '; TmpBuffer := Pointer(DWORD(tmpBuffer) + SizeOf(WKSTA_USER_INFO_1)); End; Result := Copy(Result, 1, Length(Result) - 2); End. Else. ShowMessage(SysErrorMessage(GetLastError)); Finally. NetApiBufferFree(Buffer); FreeMem(PSrvr); End; End; // Все-таки будем сканировать сеть, НО!!! // Мы не будем производить рекурсивное сканирование ресурсов с. // dwDisplayType равным RESOURCEDISPLAYTYPE_SERVER!!! // В основном все торможение происходить именно здесь, // так как эти ресурсы являются так называемыми корневыми. // для компьютеров. Если компьютер отключен его имя может сохраниться. // в кэше и при попытке сканирования получим ненужные нам тормоза. // В принципе, у меня эта функция выдавала неплохие результаты по скорости... // (Около 31 мс - максимум с отображением на memInfo, сеть 100Мб, 28 компов). Function TMainForm.GetComment(CompName, Provider: String): String; Var. StopScan: Boolean; TmpRes: TNetResource; // Само сканирование. Procedure Scan(Res: TNetResource; Root: boolean); Var. Enum, I: Cardinal; ScanRes: array [0..512] of TNetResource; // Можно сделать и больший размер массива. Size, Entries, Err: DWORD; // но, как показывает практика, такого достаточно. Begin. If StopScan then Exit; // Используем флаг для выхода из рекурсии. // Ну тут думаю все понятно... просто два типа начала сканирования. If Root = True then. Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, nil, Enum) // корневой... Else. Err := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, @Res, Enum); // и рекурсионный для поиска вложений... If Err = NO_ERROR then. Begin. Size := SizeOf(ScanRes); Entries := DWORD(-1); Err := WNetEnumResource(Enum, Entries, @ScanRes, Size); If Err = NO_ERROR then. Try. For I := 0 to Entries - 1 do. Begin. If StopScan then Exit; // Еще один флаг, так как выход на верхний вызов. With ScanRes[i] do // может осуществиться из цикла. Begin. If dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then. If lpRemoteName = CompName then // если нашли наш компьютер... Begin. Result := lpComment; // вытаскиваем комментарий. StopScan := True; // и выставляем флаг для выхода из рекуссии. Exit; End; If dwDisplayType <> RESOURCEDISPLAYTYPE_SERVER then // не будем сканировать шары у компов... Scan(ScanRes[i], False); End; End; Finally. WNetCloseEnum(Enum); End. Else. If Err <> ERROR_NO_MORE_ITEMS then // Нет элементов для отображения... MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0); End. Else. ShowMessage(SysErrorMessage(GetLastError)); End; // Основная процедура. Begin. // Подготовительные действия... Result := RES_UNKNOWN; If CompName = RES_UNKNOWN then Exit; // Если имя компа не найдено, // незачем и продолжать. CompName := '\\' + CompName; // Подправим имя, // чтоб не делать это далее в цикле... StopScan := False; // Снимем флаг выхода из рекурсии. // Здесь обязательно инициализирование переменной. // типа Boolean, так как было замечено, что. // некоторые версии Дельфи криво инициализируют. // значение по умолчанию, после чего логические. // операторы типа AND - OR - NOT перестают работать. // Например: по умолчанию переменная StopScan равна False. // без инициализации, после StopScan := not StopScan; // переменная StopScan НЕ ВСЕГДА станет True!!! // Запускаем сканирование... // (можно и в потоке, но у меня время на сканирование уходит 8 мс.). Scan(TmpRes, True); // И смотрим результаты... If Result = '' then Result := RES_COM_NO; End; // Задача этой функции предельно проста: // При известном имени компьютера мы можем заполнить структуру. // и передать ее функции WNetGetResourceParent которая и вернет. // нам предка, в моем случае группу. // Да, чуть не забыл, если имя компьютера есть в кэше, а сам. // компьютер отключен, то в качестве результата будет либо. // пустая строка либо 'Нет данных'... // Поэтому опять придется сканировать, если слишком уж критично... Function TMainForm.GetDomain(const CompName, Provider: String): String; Var. CurrRes: TNetResource; ParentName: array [0..1] of TNetResource; Enum: DWORD; Err: Integer; Begin. With CurrRes do. Begin. DwScope := RESOURCE_GLOBALNET; DwType := RESOURCETYPE_DISK; DwDisplayType := RESOURCEDISPLAYTYPE_SERVER; DwUsage := RESOURCEUSAGE_CONTAINER; LpLocalName := ''; LpRemoteName := PChar('\\' + CompName); LpComment := ''; LpProvider := PChar(Provider); End; Enum := SizeOf(ParentName); Err := WNetGetResourceParent(@CurrRes, @ParentName, Enum); If Err = NO_ERROR then. Begin. Result := ParentName[0].lpRemoteName; If Result = '' then Result := RES_COM_NO; End. Else. ShowMessage(SysErrorMessage(GetLastError)); End; // А этой функцией мы можем узнать провайдера. // (в основном это Microsoft Network). Function TMainForm.GetProvider(const CompName: String): String; Var. Buffer: array [0..255] of Char; Size: DWORD; Begin. Size := SizeOf(Buffer); If WNetGetProviderName(WNNC_NET_LANMAN, @Buffer, Size) <> NO_ERROR then. Result := RES_COM_NO. Else. Result := String(Buffer); End; // Из всех приведенных функций эта самая интересная. // Я много раз говорил о незаслуженном невнимании программистов. // к IPHLPAPI.DLL. Данный пример подтверждает это. На всех форумах. // можно услышать о получании МАС адреса посредством посылки IPX пакета. // и разбора заголовка ответа от удаленного компьютера. // (что само по себе геморой, если не принимать во внимание, // что IPX уже практически вымер, и его мало где встретишь). // Здесь же строится полная ARP таблица, на основании которой мы. // можем спокойно произвести выборку по нужному IP адресу, // а так как все берется из кэша, то мы сможем узнать МАС адреса. // даже выключенных компьютеров... // Единственный минус: в таблице (не всегда) отсутсвует информация. // по локальному компьютеру, т.е. таким образом можно получить. // все МАС адреса за исключением своего, // но для этого есть уже другие функции... // Приведу выдержку из MSDN: // You can use IP Helper to perform Address Resolution Protocol (ARP) operations for the local computer. // Use the following functions to retrieve and modify the ARP table. // The GetIpNetTable retrieves the ARP table. // The ARP table contains the mapping of IP addresses to physical addresses. // Physical addresses are sometimes referred to as Media Access Controller (MAC) addresses. // Хочу заметить что для NT есть очень интересная функция SendARP - позволяющая. // напрямую получить требуемый МАС без построения таблицы, поэтому советую. // модифицировать код программы для более эффективного исполнения участков кода. // под различными системами. Function TMainForm.GetMacFromIP(const IP: String): String; // (Будем использовать функцию приведения из статьи). // В качестве первого значения массив, второе значение, // размер данных в массиве. Function GetMAC(Value: TMacAddress; Length: DWORD): String; Var. I: Integer; Begin. If Length = 0 then Result := '00-00-00-00-00-00' else. Begin. Result := ''; For i:= 0 to Length -2 do. Result := Result + IntToHex(Value[i], 2) + '-'; Result := Result + IntToHex(Value[Length-1], 2); End; End; // Получаем IP адрес, заметь в отличии от работы с классом WC_IPADDRESS. // здесь преобразование идет в обратном порядке! Function GetDottedIPFromInAddr(const InAddr: Integer): String; Begin. Result := ''; Result := IntToStr(FOURTH_IPADDRESS(InAddr)); Result := Result + '.' + IntToStr(THIRD_IPADDRESS(InAddr)); Result := Result + '.' + IntToStr(SECOND_IPADDRESS(InAddr)); Result := Result + '.' + IntToStr(FIRST_IPADDRESS(InAddr)); End; // Основная функция. Var. Table: TMibIPNetTable; Size: Integer; CatchIP: String; Err, I: Integer; Begin. Result := RES_UNKNOWN; Size := SizeOf(Table); // Ну тут все просто... Err := GetIpNetTable(@Table, @Size, False); // Выполняем... If Err <> NO_ERROR then // Проверка на ошибку... Begin. ShowMessage(SysErrorMessage(GetLastError)); Exit; End; // Теперь мы имеем таблицу из IP адресов и соответсвующих им MAC адресов. For I := 0 to Table.dwNumEntries - 1 do // Ищем нужный IP ... Begin. CatchIP := GetDottedIPFromInAddr(Table.Table[I].dwAddr); If CatchIP = IP then // И выводим его МАС ... Begin. Result := GetMAC(Table.Table[I].bPhysAddr, Table.Table[I].dwPhysAddrLen); Break; End; End; End; // Полуение доступных сетевых ресурсов на удаленном компьютере. Function TMainForm.GetShares(const CompName: String): String; Type TShareInfo1Array = array of TShareInfo1; Var. Entriesread, totalentries: DWORD; Info: Pointer; I: Integer; CN: PWideChar; Begin. CN := StringToOleStr(CompName); // так как нам нужны только имена ресурсов, воспользуемся струтурой TShareInfo1. // тогда, не нужно будет получать привилегии администратора на удаленной машине :). If NetShareEnum(CN, 1, Info, DWORD(-1), @entriesread, @totalentries, nil) = 0 then. Try // список ресурсов смотрим здесь. If entriesread > 0 then. For I := 0 to entriesread - 1 do. Result := Result + TShareInfo1Array(@(Info^))[I].shi1_netname + ' '; Finally. NetApiBufferFree(Info); End; End; // Вот таким простым путем будем получать имя сервера домена. Function TMainForm.GetDomainServer(const DomainName: String): String; Var. PwDomain:pWideChar; PwServer:pWideChar; Begin. GetMem(pwDomain, 512); GetMem(pwServer, 512); StringToWideChar(DomainName, pwDomain, 255); NetGetAnyDCName(nil, pwDomain, @pwServer); Result := WideCharToString(pwServer); NetApiBufferFree(pwServer); FreeMem(pwDomain, 512); End; // перечисление доменных групп в которые входит пользователь. Function TMainForm.GetGroups(DomainServer: String; UserName: String): String; Type. TGroupUsersInfoArray = array of TGroupUsersInfo0; Var. Info: PGroupUsersInfo0; Sn, Un: PWideChar; Entriesread, totalentries: DWORD; I, A, B, Size: Integer; P: Pointer; Begin. // нам нужно только имя сервера домена. Sn := StringToOLEStr(DomainServer); // и имя пользователя. Un := StringToOleStr(UserName); // делаем запрос. If NetUserGetGroups(Sn, Un, 0, @Info, DWORD(-1), entriesread, totalentries) = NO_ERROR then. Try // и смотрим, что там у нас получилось. If entriesread > 0 then. For I := 0 to entriesread - 1 do. Result := Result + TGroupUsersInfoArray(@(Info^))[I].grui0_name + ' '; Finally. NetApiBufferFree(Info); End; End; End.

Не работает кнопка <Enter> в WebBrowser.

Html страницы, отображаемые в TWebBrowser часто имеют кнопки "Submit", и нажатие <Enter> не воспринимается непосредственно этой кнопкой.

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw_TLB, ActiveX, StdCtrls; Type. TForm1 = class(TForm). WebBrowser1: TWebBrowser; Button1: TButton; Button2: TButton; Procedure FormDestroy(Sender: TObject); Procedure FormCreate(Sender: TObject); Procedure Button1Click(Sender: TObject); Procedure Button2Click(Sender: TObject); Private. { Private declarations }. FOleInPlaceActiveObject: IOleInPlaceActiveObject; Procedure MsgHandler(var Msg: TMsg; var Handled: Boolean); Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.FormDestroy(Sender: TObject); Begin. FOleInPlaceActiveObject := nil; End; Procedure TForm1.FormCreate(Sender: TObject); Begin. Application.OnMessage := MsgHandler; End; Procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean); Var. IOIPAO: IOleInPlaceActiveObject; Dispatch: IDispatch; Begin. If not Assigned(WebBrowser1) then. Begin. Handled := False; Exit; End; Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True); If (Handled) and (not WebBrowser1.Busy) then. Begin. If FOleInPlaceActiveObject = nil then. Begin. Dispatch := WebBrowser1.Application; If Dispatch <> nil then. Begin. Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO); If iOIPAO <> nil then. FOleInPlaceActiveObject := iOIPAO; End; End; If FOleInPlaceActiveObject <> nil then. If ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and. ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT)) then. //nothing - do not pass on Backspace, Left or Right arrows. Else. FOleInPlaceActiveObject.TranslateAccelerator(Msg); End; End;

Cut и Copy отказываются работать.

Вам нужно добавить следующие строки в конец unit:

Code: Initialization. OleInitialize(nil); Finalization. OleUninitialize;

Преобразование изображения в оттенки серого.

Code: // Используется функция преобразования изображения в оттенки серого. // взятая из UBPFD - http://delphibase.endimus.com/ // автор: Николай Федоровских - mailto: chook_nu@uraltc.ru. Procedure ModColors(Bitmap: TBitmap; Color: TColor); Function GetR(const Color: TColor): Byte; //извлечение красного. Begin. Result := Lo(Color); End; Function GetG(const Color: TColor): Byte; //извлечение зелёного. Begin. Result := Lo(Color shr 8); End; Function GetB(const Color: TColor): Byte; //извлечение синего. Begin. Result := Lo((Color shr 8) shr 8); End; Function BLimit(B: Integer): Byte; Begin. If B < 0 then Result := 0. Else if B > 255 then Result := 255. Else Result := B; End; Type TRGB = record. B, G, R: Byte; End; PRGB = ^TRGB; Var r1, g1, b1: Byte; X, y: Integer; Dest: pRGB; A: Double; Begin. Bitmap.PixelFormat := pf24Bit; R1 := Round(255 / 100 * GetR(Color)); G1 := Round(255 / 100 * GetG(Color)); B1 := Round(255 / 100 * GetB(Color)); For y := 0 to Bitmap.Height - 1 do begin. Dest := Bitmap.ScanLine[y]; For x := 0 to Bitmap.Width - 1 do begin. With Dest^ do begin. A := (r + b + g) / 300; With Dest^ do begin. R := BLimit(Round(r1 * A)); G := BLimit(Round(g1 * A)); B := BLimit(Round(b1 * A)); // Небольшая поправка к оригинальной функции. If (R=255) and (G=255) and (B=255) then begin. R:= 216; G:= 212; B:= 240; End; End; End; Inc(Dest); End; End; End;

Пример градиентной заливки формы.

Иногда бывает нужно сложить два или более цветов для получения что-то типа переходного цвета. Делается это весьма просто. Координаты получаемого цвета будут равны среднему значению соответствующих координат всех цветов.

Например, нужно сложить красный и синий. Получаем.

(255,0,0)+(0,0,255)=((255+0) div 2,(0+0) div 2,(0+255) div 2)=(127,0,127).

В результате получаем сиреневый цвет. Также надо поступать, если цветов более чем 2: сложить соответствующие координаты, потом каждую сумму разделить нацело на количество цветов.

Поговорим теперь о градиентной заливке. Градиентная заливка - это заливка цветом с плавным переходом от одного цвета к другому.

Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить. Тогда каждый цвет каждого пиксела, находящегося на расстоянии x пикселов от начала будет равен (A1-(A1-B1)/h*x, A2-(A2-B2)/h*x, A3-(A3-B3)/h*x). Теперь, имея линию с градиентной заливкой, можно таким образом залить совершенно любую фигуру: будь то прямоугольник, круг или просто произвольная фигура.

Вот как выглядит описанный алгоритм:

Code: {Считается, что координаты первого цвета равны (A1, A2, A3), а второго (B1, B2, B3). Кроме того, линия начинается в координатах (X1,Y1), а заканчивается в (X2,Y1)}. Var h, i: integer; Begin. H:=X2-X1-1; For i:=0 to h do. With PaintBox1.Canvas do. Begin. Pen.Color:=RGB(A1-(A1-B1)/h*i, A2-(A2-B2)/h*i, A3-(A3-B3)/h*i); Rectangle(I,Y1,I+1,Y1); End; End.

Mischka.

Цитата.

Feriman, 13.09.04, 15:14.

Подкиньте примерчик градиентной заливки формы.

Вот посмотри:

Code: Unit Graph32; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Graphics; Type. TRGB = record. B, G, R: byte; End; ARGB = array [0..1] of TRGB; PARGB = ^ARGB; Procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. Bitmap: TBitmap; P: PARGB; Implementation. Procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); Dr:=(getRValue(c2)-r1)/Bitmap.Width; Dg:=(getGValue(c2)-g1)/Bitmap.Width; Db:=(getBValue(c2)-b1)/Bitmap.Width; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. P[x].R:=round(r1+x*dr); P[x].G:=round(g1+x*dg); P[x].B:=round(b1+x*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); Dr:=(getRValue(c2)-r1)/Bitmap.Height; Dg:=(getGValue(c2)-g1)/Bitmap.Height; Db:=(getBValue(c2)-b1)/Bitmap.Height; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. P[x].R:=round(r1+y*dr); P[x].G:=round(g1+y*dg); P[x].B:=round(b1+y*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db, d: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); D:=sqrt(Bitmap.Width*Bitmap.Width+Bitmap.Height*Bitmap.Height)/2; Dr:=(getRValue(c2)-r1)/d; Dg:=(getGValue(c2)-g1)/d; Db:=(getBValue(c2)-b1)/d; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. D:=sqrt(((Bitmap.Width-2*x)*(Bitmap.Width-2*x)+(Bitmap.Height-2*y)*(Bitmap.Height-2*y))/4); P[x].R:=round(r1+d*dr); P[x].G:=round(g1+d*dg); P[x].B:=round(b1+d*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Initialization. Begin. Bitmap:=TBitmap.create(); Bitmap.PixelFormat:=pf24bit. End; Finalization. Begin. Bitmap.free(). End; End.

Автор: Kostas.

©Drkb::00427.

Code: Unit Graph32; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Graphics; Type. TRGB = record. B, G, R: byte; End; ARGB = array [0..1] of TRGB; PARGB = ^ARGB; Procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. Bitmap: TBitmap; P: PARGB; Implementation. Procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); Dr:=(getRValue(c2)-r1)/Bitmap.Width; Dg:=(getGValue(c2)-g1)/Bitmap.Width; Db:=(getBValue(c2)-b1)/Bitmap.Width; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. P[x].R:=round(r1+x*dr); P[x].G:=round(g1+x*dg); P[x].B:=round(b1+x*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); Dr:=(getRValue(c2)-r1)/Bitmap.Height; Dg:=(getGValue(c2)-g1)/Bitmap.Height; Db:=(getBValue(c2)-b1)/Bitmap.Height; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. P[x].R:=round(r1+y*dr); P[x].G:=round(g1+y*dg); P[x].B:=round(b1+y*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: integer; Color1, Color2: TColor); Var. X, y, c1, c2, r1, g1, b1: integer; Dr, dg, db, d: real; Begin. Bitmap.Width:=abs(X1-X2); Bitmap.Height:=abs(Y1-Y2); C1:=ColorToRGB(Color1); R1:=getRValue(c1); G1:=getGValue(c1); B1:=getBValue(c1); C2:=ColorToRGB(Color2); D:=sqrt(Bitmap.Width*Bitmap.Width+Bitmap.Height*Bitmap.Height)/2; Dr:=(getRValue(c2)-r1)/d; Dg:=(getGValue(c2)-g1)/d; Db:=(getBValue(c2)-b1)/d; For y:=0 to Bitmap.Height-1 do. Begin. P:=Bitmap.ScanLine[y]; For x:=0 to Bitmap.Width-1 do. Begin. D:=sqrt(((Bitmap.Width-2*x)*(Bitmap.Width-2*x)+(Bitmap.Height-2*y)*(Bitmap.Height-2*y))/4); P[x].R:=round(r1+d*dr); P[x].G:=round(g1+d*dg); P[x].B:=round(b1+d*db). End. End; Canvas.Draw(X1, Y1, Bitmap). End; Initialization. Begin. Bitmap:=TBitmap.create(); Bitmap.PixelFormat:=pf24bit. End; Finalization. Begin. Bitmap.free(). End; End.

Получение изображения экрана.

Code: // В качестве параметров передаются: // AHandle - хэндл окна, скриншот которого мы хочем получить. // CompressPercent - процент сжатия картинки. // AImage - картинка, в которую будет помещено изображение. // в случае успешного скриншота функция вернет True. {©Drkb v.3(2007): www.drkb.ru}. Function GetScreenShot(const AHandle: THandle; const CompressPercent: Byte; Var AImage: TJPEGImage): Boolean; Var. FBitmap: TBitmap; DC: HDC; Rect: TRect; Begin. Result := False; If AImage = nil then Exit; DC := GetDC(AHandle); If DC <> 0 then. Try. FBitmap := TBitmap.Create; Try. If not GetClientRect(AHandle, Rect) then Exit; FBitmap.Width := Rect.Right - Rect.Left; FBitmap.Height := Rect.Bottom - Rect.Top; FBitmap.PixelFormat := pf32bit; Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width, FBitmap.Height, DC, 0, 0, SRCCOPY); If not Result then Exit; AImage.Assign(fBitmap); AImage.CompressionQuality := CompressPercent; Finally. FBitmap.Free; End; Finally. ReleaseDC(AHandle, DC); End; End; // Пример использования... Procedure TForm1.Button1Click(Sender: TObject); Var. Image: TJPEGImage; Begin. // Скриншот рабочего стола. Image := TJPEGImage.Create; Try. If GetScreenShot(GetDesktopWindow, 150, Image) then. Image1.Picture.Assign(Image); Finally. Image.Free; End; // Скриншот нашей формы. Image := TJPEGImage.Create; Try. If GetScreenShot(Handle, 150, Image) then. Image2.Picture.Assign(Image); Finally. Image.Free; End; End;

Автор Rouse_

©Drkb::01847.

Взято из http://forum.sources.ru.

Инверсия всех цветов в TBitmap.

Code: Function InvertBitmap(Bmp: TBitmap): TBitmap; Var. X, y: integer; ByteArray: PByteArray; Begin. Bmp.PixelFormat := pf24Bit; For y := 0 to Bmp.Height - 1 do. Begin. ByteArray := Bmp.ScanLine[y]; For x := 0 to Bmp.Width * 3 - 1 do. Begin. ByteArray[x] := 255 - ByteArray[x]; End; End; Result := Bmp; End; Procedure TForm1.Button1Click(Sender: TObject); Begin. Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap); End;

Манипулирование кнопками OpenDialog.

Code: Uses. CommCtrl; // Example: Hide the "Create New Folder" Button. Procedure TForm1.OpenPictureDialog1Show(Sender: TObject); Const. TB_BTN_NEWFOLDER = 40962; Var. HWndToolbar, wnd: HWND; TbInfo: TTBButtonInfoA; Begin. TbInfo.cbSize := SizeOf(TTBButtonInfo); TbInfo.dwMask := TBIF_STATE; Tbinfo.fsState := TBSTATE_HIDDEN or TBSTATE_INDETERMINATE; HWndToolbar := FindWindowEx(GetParent((Sender as TOpenPictureDialog).Handle), 0, 'ToolbarWindow32', nil); SendMessage(hWndToolbar, TB_SETBUTTONINFO, TB_BTN_NEWFOLDER ,LParam(@tbinfo)); End;

Определить формат изображения, загруженного в TMemoryStream.

Code: Type. ImageType = (NoImage, Bmp, Gif, Gif89, Png, Jpg); Function KindOfImage(Start: Pointer): ImageType; Type. ByteArray = array[0..10] of byte; Var. PB: ^ByteArray absolute Start; PW: ^Word absolute Start; PL: ^DWord absolute Start; Begin. If PL^ = $38464947 then. Begin. If PB^[4] = Ord('9') then Result := Gif89. Else Result := Gif; End. Else if PW^ = $4D42 then Result := Bmp. Else if PL^ = $474E5089 then Result := Png. Else if PW^ = $D8FF then Result := Jpg. Else Result := NoImage; End;

Изменение глубины цвета изображения.

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). Button1: TButton; Procedure Button1Click(Sender: TObject); Public. Function ChangeColorDepth(const FromBMP: TBitmap; out ToBMP: TBitmap; Const ColorDepth: TPixelFormat): Boolean; End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.Button1Click(Sender: TObject); Var. B24, B16: TBitmap; Begin. B24 := TBitmap.Create; Try. B24.LoadFromFile('c:\1.bmp'); If ChangeColorDepth(B24, B16, pf4bit) then. Try. B16.SaveToFile('c:\2.bmp'); Finally. B16.Free; End; Finally. B24.Free; End; End; Function TForm1.ChangeColorDepth(const FromBMP: TBitmap; Out ToBMP: TBitmap; const ColorDepth: TPixelFormat): Boolean; Begin. Result := True; Try. ToBMP := TBitmap.Create; ToBMP.Width := FromBMP.Width; ToBMP.Height := FromBMP.Height; ToBMP.PixelFormat := ColorDepth; ToBMP.Canvas.Draw(0, 0, FromBMP); Except. If ToBMP <> nil then ToBMP.Free; Result := False; End; End; End.

Информация о AVI файле, (разбор заголовка AVI).

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; Type. TForm1 = class(TForm). Memo1: TMemo; OpenDialog1: TOpenDialog; Button1: TButton; Procedure Button1Click(Sender: TObject); Public. Procedure ReadAviInfo(FileName: String); End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.ReadAviInfo(FileName: String); Var. IFileHandle: Integer; // хэндл файла. // Для позмционирования в AVI файле. Aviheadersize: Integer; Vheadersize: Integer; Aviheaderstart: Integer; Vheaderstart: Integer; Aheaderstart: Integer; Astrhsize: Integer; // Временные переменные. TempTest: String[5]; TempSize: Integer; TempVcodec: String[5]; TempAcodec: Integer; TempMicrosec: Integer; TempLengthInFrames: Integer; TempAchannels: Integer; TempAsamplerate: Integer; TempAbitrate: Integer; //Выходные данные. Size: Double; Length: String; Vcodec: String; Vbitrate: Double; VWidth: Integer; VHeight: Integer; Fps: Double; LengthInSec: Double; Acodec: String; Abitrate: String; Begin. // Открываем. IFileHandle := FileOpen(FileName, fmOpenRead); // Грубая проверка на подлинность файла. FileSeek(iFileHandle, 7, 0); FileRead(iFileHandle, TempTest, 5); If copy(TempTest, 0, 4) <> 'AVI ' then. Begin. MessageDlg('Could not open ' + FileName + ' because it is not a valid video file', mtError, [mbOk], 0); Exit; End; // Размер файла. FileSeek(iFileHandle,4,0); FileRead(iFileHandle, TempSize, 4); // Размер хедера (needed To locate the audio part). FileSeek(iFileHandle,28,0); FileRead(iFileHandle, Aviheadersize, 4); // старт хедера (needed To locate the video part). Aviheaderstart := 32; // Милисекунды (1000000 / TempMicrosec = fps). FileSeek(iFileHandle,Aviheaderstart,0); FileRead(iFileHandle, TempMicrosec, 4); // Размер во фреймах. FileSeek(iFileHandle,Aviheaderstart + 16,0); FileRead(iFileHandle, TempLengthInFrames, 4); // Ширина. FileSeek(iFileHandle,Aviheaderstart + 32,0); FileRead(iFileHandle, VWidth, 4); // Высота. FileSeek(iFileHandle,Aviheaderstart + 36,0); FileRead(iFileHandle, VHeight, 4); FileSeek(iFileHandle,Aviheaderstart + Aviheadersize + 4,0); FileRead(iFileHandle, Vheadersize, 4); Vheaderstart := Aviheaderstart + Aviheadersize + 20; // кодек. FileSeek(iFileHandle,Vheaderstart + 3,0); FileRead(iFileHandle, TempVCodec, 5); Aheaderstart := Vheaderstart + Vheadersize + 8; FileSeek(iFileHandle,Aheaderstart - 4,0); FileRead(iFileHandle, Astrhsize, 5); // Audio codec. FileSeek(iFileHandle,Aheaderstart + Astrhsize + 8,0); FileRead(iFileHandle, TempACodec, 2); // Audio каналы (1 = mono, 2 = stereo). FileSeek(iFileHandle,Aheaderstart + Astrhsize + 10,0); FileRead(iFileHandle, TempAchannels, 2); // Audio samplerate. FileSeek(iFileHandle,Aheaderstart + Astrhsize + 12,0); FileRead(iFileHandle, TempAsamplerate, 4); // Audio bitrate. FileSeek(iFileHandle,Aheaderstart + Astrhsize + 16,0); FileRead(iFileHandle, TempAbitrate, 4); // закрываем файл. FileClose(iFileHandle); // анализируем видео кодек (можно добавить больше). Vcodec := copy(TempVcodec, 0, 4); If Vcodec = 'div2' then Vcodec := 'MS MPEG4 v2' Else If Vcodec = 'DIV2' then Vcodec := 'MS MPEG4 v2' Else If Vcodec = 'div3' then Vcodec := 'DivX;-) MPEG4 v3' Else If Vcodec = 'DIV3' then Vcodec := 'DivX;-) MPEG4 v3' Else If Vcodec = 'div4' then Vcodec := 'DivX;-) MPEG4 v4' Else If Vcodec = 'DIV4' then Vcodec := 'DivX;-) MPEG4 v4' Else If Vcodec = 'div5' then Vcodec := 'DivX;-) MPEG4 v5' Else If Vcodec = 'DIV5' then Vcodec := 'DivX;-) MPEG4 v5' Else If Vcodec = 'divx' then Vcodec := 'DivX 4' Else If Vcodec = 'mp43' then Vcodec := 'Microcrap MPEG4 v3'; // тоже с аудио. Case TempAcodec of. 0: Acodec := 'PCM'; 1: Acodec := 'PCM'; 85: Acodec := 'MPEG Layer 3'; 353: Acodec := 'DivX;-) Audio'; 8192: Acodec := 'AC3-Digital'; Else. Acodec := 'Unknown (' + IntToStr(TempAcodec) + ')'; End; Case (Trunc(TempAbitrate / 1024 * 8)) of. 246..260: Abitrate := '128 Kbit/s'; 216..228: Abitrate := '128 Kbit/s'; 187..196: Abitrate := '128 Kbit/s'; 156..164: Abitrate := '128 Kbit/s'; 124..132: Abitrate := '128 Kbit/s'; 108..116: Abitrate := '128 Kbit/s'; 92..100: Abitrate := '128 Kbit/s'; 60..68: Abitrate := '128 Kbit/s'; Else. Abitrate := FormatFloat('# Kbit/s', TempAbitrate / 1024 * 8); End; // тут некоторые вычисления. Size := TempSize / 1024 / 1024; Fps := 1000000 / TempMicrosec; // FPS. LengthInSec := TempLengthInFrames / fps; // Length In seconds. Length := FormatFloat('# min', Int(LengthInSec / 60)) + FormatFloat(' # sec', Round(LengthInSec - (Int(LengthInSec / 60) * 60))); Vbitrate := (TempSize / LengthInSec - TempABitrate) / 1024 * 8; // Выводим инфу в мемо. Memo1.Lines.Add('AVI INFORMATION'); Memo1.lines.Add('Size: ' + FormatFloat('#.## MB',Size)); Memo1.Lines.Add('Length: ' + Length); Memo1.Lines.Add(''); Memo1.Lines.Add('VIDEO INFORMATION'); Memo1.Lines.Add('Codec: ' + Vcodec); Memo1.Lines.Add('Bitrate: ' + FormatFloat('# Kbit/s', Vbitrate)); Memo1.lines.Add('Width: ' + IntToStr(VWidth) + ' px'); Memo1.lines.Add('Height: ' + IntToStr(VHeight) + ' px'); Memo1.Lines.Add('FPS: ' + FormatFloat('#.##', fps)); Memo1.Lines.Add(''); Memo1.Lines.Add('AUDIO INFORMATION'); Memo1.Lines.Add('Codec: ' + Acodec); Memo1.Lines.Add('Bitrate: ' + Abitrate); End; Procedure TForm1.Button1Click(Sender: TObject); Begin. If OpenDialog1.Execute Then ReadAviInfo(OpenDialog1.FileName); End; End.

Удобная функция ifthen.

В Делфи 6 (модуль Math) появилась удобная функция ifthen которая соответствует оператору "?" языка С++.

Пример:

Code: {©Drkb v.3(2007): www.drkb.ru}. Procedure TForm1.Button1Click(Sender: TObject); Var k, i, j: Integer; Begin. I := 3; j := 2; K := ifthen({If}i < j, {Then}i, {Else}k); End;

Использование PosEx взамен Pos.

В Delphi 7 в модуле StrUtils внесены некоторые изменения.

Есть новая функция: PosEx.

Обьявление этих функций:

Code: Function Pos(Substr: String; S: String): Integer; Function PosEx(Const SubStr, S: String; Offset: Cardinal = 1): Integer;

Новая функция PosEx, позволяет указать начальную позицию поиска внутри строки, что избавит вас от необходимости изменения исходной строки. Незабудьте указать модуль StrUtils.

Форма изменяющая размеры без заголовка.

Форма изменяющая размеры без заголовка.

Нужно выставить свойство формы BorderStyle := bsNone;

Code: Type. TForm1 = class(TForm). ... Protected. Procedure CreateParams(var Params: TCreateParams); override; End; Var. Form1: TForm1; Implementation. {$R *.dfm}. Procedure TForm1.CreateParams(var Params: TCreateParams); Begin. Inherited; Params.Style := (Params.Style or WS_THICKFRAME); End;

Пример очистки куков и Temporaly Internet Files.

Code: Uses ..., WinInet; {©Drkb v.3(2007): www.drkb.ru}. Procedure DeleteCache; Var. LpEntryInfo: PInternetCacheEntryInfo; HCacheDir: LongWord; DwEntrySize: LongWord; Begin. DwEntrySize := 0; FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); Try. If dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize; HCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); If hCacheDir <> 0 then. Try. Repeat. DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); FreeMem(lpEntryInfo, dwEntrySize); DwEntrySize := 0; FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); If dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize; Until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize); Finally. FindCloseUrlCache(hCacheDir); End; Finally. FreeMem(lpEntryInfo, dwEntrySize); End; End;

Модуль поиска по маске (более совершеный нежели дельфийский masks).

Code: Unit awMachMask; // © Alexandr Petrovich Sysoev. Interface. Uses Classes; ///////////////////////////////////////////////////// Работа со списком шаблонов. // Функции предназначены для сопоставления текстов (имен файлов) на. // соответствие заданному шаблону или списку шаблонов. // Обычно используется для посторения простых фильтров, например аналогичных. // файловым фильтрам программы Total Commander. // // Каждый шаблон аналогичен шаблону имен файлов в MS-DOS и MS Windows, // т.е. может включать "шаблонные" символы '*' и '?' и не может включать. // символ '|'. // Любой шаблон может быть заключен в двойные кавычки ('''), при этом двойные. // кавычки имеющиеся в шаблоне должны быть удвоены. Если шаблон включает. // символы ';' или ' ' (пробел) то он обязательно должен быть заключен в. // двойные кавычки. // В списке, шаблоны разделяются символом ';'. // За первым списком шаблонов, может следовать символ '|', за которым может. // следовать второй список. // Текст (имя файла) будет считаться соответствующим списку шаблонов только. // если он соответствует хотя бы одному шаблону из первого списка, // и не соответствует ни одному шаблону из второго списка. // Если первый список пуст, то подразумевается '*' // // Формальное описание синтаксиса списка шаблонов: // // Полный список шаблонов :: [<список включаемых шаблонов>]['|'<список исключаемых шаблонов>]. // список включаемых шаблонов :: <список шаблонов> // список исключаемых шаблонов :: <список шаблонов> // список шаблонов :: <шаблон>[';'<шаблон>]. // шаблон :: шаблон аналогичный шаблону имен файлов в. // MS-DOS и MS Windows, т.е. может включать. // "шаблонные" символы '*' и '?' и не может. // включать символ '|'. Шаблон может быть. // заключен в двойные кавычки (''') при этом. // двойные кавычки имеющиеся в шаблоне должны. // быть удвоены. Если шаблон включает символы. // ';' или ' ' (пробел) то он. // обязательно должен быть заключен в двойные. // кавычки. // // Например: // '*.ini;*.wav' - соответствует любым файлам с расшиениями 'ini' // или 'wav' // '*.*|*.exe' - соответствует любым файлам, кроме файлов с. // расширением 'EXE' // '*.mp3;*.wav|?.*;??.*' - соответствует любым файлам с расшиениями 'mp3' // и 'wav' за исключением файлов у которых имя. // состоит из одного или двух символов. // '|awString.*' - соответствует любым файлам за исключением файлов. // с именем awString и любым расширением. // Function IsMatchMask (aText, aMask :pChar ) :Boolean; overload; Function IsMatchMask (aText, aMask :String; aFileNameMode :Boolean =True) :Boolean; overload; // Выполняют сопоставление текста aText с одним шаблоном aMask. // Возвращает True если сопоставление выполнено успешно, т.е. текст. // aText соответствует шаблону aMask. // Если aFileNameModd=True, то объект используется для сопоставления. // имен файлов с шаблоном. А именно, в этом случае, если aText не. // содержит символа '.' то он добавляется в конец. Это необходимо для. // того, чтобы файлы без расширений соответствовали например шаблону '*.*' Function IsMatchMaskList (aText, aMaskList :String; aFileNameMode :Boolean =True): Boolean; // Выполняет сопоставление текста aText со списком шаблонов aMaskList. // Возвращает True если сопоставление выполнено успешно, т.е. текст. // aText соответствует списку шаблонов aMaskList. // Если aFileNameModd=True, то объект используется для сопоставления. // имен файлов с шаблоном. А именно, в этом случае, если aText не. // содержит символа '.' то он добавляется в конец. Это необходимо для. // того, чтобы файлы без расширений соответствовали например шаблону '*.*' // // Замечание, если требуется проверка сопоставления нескольких строк одному. // списку шаблонов, эффективнее будет воспользоваться объектом tMatchMaskList. Type. TMatchMaskList = class(tObject). Private. FMaskList :String; FCaseSensitive :Boolean; FFileNameMode :Boolean; FPrepared :Boolean; FIncludeMasks :tStringList; FExcludeMasks :tStringList; Procedure SetMaskList (v :String ); Procedure SetCaseSensitive (v :Boolean); Public. Constructor Create (Const aMaskList :String =''); // Создает объект. Если задан параметр aMaskList, то он присваивается. // свойству MaskList. Destructor Destroy; override; // Разрушает объект. Procedure PrepareMasks; // Осуществляет компиляцию списка шаблонов во внутреннюю структуру. // используемую при сопоставлении текста. // Вызов данного метода не является обязательным и при необходимости. // будет вызван автоматически. Function IsMatch (aText :String) :Boolean; // Выполняет сопоставление текста aText со списком шаблонов MaskList. // Возвращает True если сопоставление выполнено успешно, т.е. текст. // aText соответствует списку шаблонов MaskList. Property MaskList :String Read fMaskList Write SetMaskList ; // Списко шаблонов используемый для сопоставления с текстом. Property CaseSensitive :Boolean Read fCaseSensitive Write SetCaseSensitive default False; // Если False (по умолчанию), то при сопоставлении текста будет. // регистр символов не будет учитываться. // Иначе, если True, сопоставление будет проводиться с учетом регистра. Property FileNameMode :Boolean Read fFileNameMode Write fFileNameMode default True; // Если True (по умолчанию), то объект используется для сопоставления. // имен файлов с шаблоном. А именно, в этом случае, если aText не. // содержит символа '.' то он добавляется в конец. Это необходимо для. // того, чтобы файлы без расширений соответствовали например шаблону '*.*' End; Implementation. Uses. SysUtils. ; Function IsMatchMask (aText, aMask :pChar ) :Boolean; overload; Begin. Result := False; While True Do begin. Case aMask^ of. '*' : // соответствует любому числу любых символов кроме конца строки. Begin. // переместиться на очередной символ шаблона, при этом, подряд. // идущие '*' эквивалентны одному, поэтому пропуск всех '*' Repeat Inc(aMask); Until (aMask^<>'*'); // если за '*' следует любой символ кроме '?' то он должен совпасть. // с символом в тексте. т.е. нужно пропустить все не совпадающие, // но не далее конца строки. If aMask^ <> '?' then. While (aText^ <> #0) And (aText^ <> aMask^) Do Inc(aText); If aText^ <> #0 Then begin // не конец строки, значит совпал символ. // '*' 'жадный' шаблон поэтому попробуем отдать совпавший символ. // ему. т.е. проверить совпадение продолжения строки с шаблоном, // начиная с того-же '*'. если продолжение совпадает, то. If IsMatchMask (aText+1, aMask-1) Then Break; // это СОВПАДЕНИЕ. // продолжение не совпало, значит считаем что здесь закончилось. // соответствие '*'. Продолжим сопоставление со следующего. // символа шаблона. Inc(aMask); Inc(aText); // иначе переходим к следующему символу. End. Else If (aMask^ = #0) Then // конец строки и конец шаблона. Break // это СОВПАДЕНИЕ. Else // конец строки но не конец шаблона. Exit // это НЕ СОВПАДЕНИЕ. End; '?' : // соответствует любому кроме конца строки. If (aText^ = #0) Then // конец строки. Exit // это НЕ СОВПАДЕНИЕ. Else begin // иначе. Inc(aMask); Inc(aText); // иначе переходим к следующему символу. End; Else // символ в шаблоне должен совпасть с символом в строке. If aMask^ <> aText^ Then // символы не совпали - Exit // это НЕ СОВПАДЕНИЕ. Else begin // совпал очередной символ. If (aMask^ = #0) Then // совпавший символ последний - Break; // это СОВПАДЕНИЕ. Inc(aMask); Inc(aText); // иначе переходим к следующему символу. End; End; End; Result := True; End; Function IsMatchMask (aText, aMask :String; aFileNameMode :Boolean =True) :Boolean; overload; Begin. If aFileNameMode And (Pos('.',aText)=0) then aText := aText+'.'; Result := IsMatchMask(pChar(aText),pChar(aMask)); End; Function IsMatchMaskList (aText, aMaskList :String; aFileNameMode :Boolean =True) :Boolean; Begin. With tMatchMaskList.Create(aMaskList) Do try. FileNameMode := aFileNameMode; Result := IsMatch(aText); Finally. Free; End; End; /////////////////////////////////////////////////////////// tFileMask. Procedure tMatchMaskList.SetMaskList (v :String ); Begin. If fMaskList = v Then Exit; FMaskList := v; FPrepared := False; End; Procedure tMatchMaskList.SetCaseSensitive (v :Boolean); Begin. If fCaseSensitive = v Then Exit; FCaseSensitive := v; FPrepared := False; End; Constructor tMatchMaskList.Create (Const aMaskList :String); Begin. MaskList := aMaskList; FFileNameMode := True; FIncludeMasks := TStringList.Create; With fIncludeMasks Do begin. Delimiter := ';'; // Sorted := True; // Duplicates := dupIgnore; End; FExcludeMasks := tStringList.Create; With fExcludeMasks Do begin. Delimiter := ';'; // Sorted := True; // Duplicates := dupIgnore; End; End; Destructor tMatchMaskList.Destroy; Begin. FIncludeMasks.Free; FExcludeMasks.Free; End; Procedure tMatchMaskList.PrepareMasks; Procedure CleanList(l :tStrings); Var i :Integer; Begin. For i := l.Count-1 downto 0 Do If l[i] = '' then l.Delete(i); End; Var. S :String; I :Integer; Begin. If fPrepared Then Exit; If CaseSensitive Then. S := MaskList. Else. S := UpperCase(MaskList); I := Pos('|',s); If i = 0 Then begin. FIncludeMasks.DelimitedText := s; FExcludeMasks.DelimitedText := ''; End. Else begin. FIncludeMasks.DelimitedText := Copy(s,1,i-1); FExcludeMasks.DelimitedText := Copy(s,i+1,MaxInt); End; CleanList(fIncludeMasks); CleanList(fExcludeMasks); // если список включаемых шаблонов пуст а. // список исключаемых шаблонов не пуст, то. // имеется ввиду что список включаемых шаблонов равен <все файлы> If (fIncludeMasks.Count = 0) And (fExcludeMasks.Count <> 0) Then. FIncludeMasks.Add('*'); FPrepared := True; End; Function tMatchMaskList.IsMatch (aText :String) :Boolean; Var. I :Integer; Begin. Result := False; If aText = '' then Exit; If Not CaseSensitive Then aText := UpperCase(aText); If FileNameMode And (Pos('.',aText)=0) then aText := aText+'.'; If Not fPrepared Then PrepareMasks; // поиск в списке "включаемых" масок до первого совпадения. For i := 0 To fIncludeMasks.Count-1 Do. If IsMatchMask(PChar(aText),PChar(fIncludeMasks[i])) Then begin. Result := True; Break; End; // если совпадение найдено, надо проверить по списку "исключаемых". If Result Then. For i := 0 To fExcludeMasks.Count-1 Do. If IsMatchMask(PChar(aText),PChar(fExcludeMasks[i])) Then begin. Result := False; Break; End; End; End.

Работа с массивом компонентов.

Автор: RoboSol.

Часто возникают вопросы о работе с массивом компонентов. вот пример того как вывести список имен всех компонентов в приложении.

Code: Procedure TForm1.Button1Click(Sender : TObject); {©Drkb v.3(2007): www.drkb.ru}. Var i : integer; Begin. ListBox1.Items.Clear; For i:=0 to ComponentCount-1 do ListBox1.Items.Add(Components[i].Name); End;

Для поиска конкретного компонента по его имени используйте метод формы - FindComponent.

Для поиска вишестоящего компонента воспользуйтесь функцией - FindGlobalComponent.

Примечание: в Delphi некоторые компоненты сами по себе являются контейнерами компонентов (GroupBox, Panel, PageControl, Form). В этом случаэ контейнер является родителем этих компонентов (Parent), а форма их владельцем (Owner). Для перехода по дочерних компонентах можно воспользоваться свойством Controls родителя компонентов. А для перехода независимо от родителя - используйте свойство Controls формы.

Смена владельца:

Свойство Owner - только для чтения, поэтому изменить его нельзя. Владелец устанавливается в ходе создания. Нестоит попросту изменять владельца или имя компонента. Но если есть такая необходимость можно воспользоватся методами: InsertComponent и RemoveComponent самого владельца. Эти методы нельзя применять в обработчике события формы.

Решение задачи:

Code: Procedure ChangeOwner( Component, NewOwner : TComponent); Begin. Component.Owner.RemoveComponent(Component); NewOwner.InsertComponent(Component); End;

Пример использования:

Code: Procedure TForm1.ButtonChangeClick(Sender : TObject); Begin. If Assigned(Button1) then. Begin. Button1.Parent:=Form2; ChangeOwner(Button1. Form2); End; End;

Функции для изменения и получения чуствительности мышки.

Code: Function SetMouseSpeed ( NewSpeed : Integer ) : Boolean; {©Drkb v.3(2007): www.drkb.ru}. 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;

Сохранение и загрузка двумерного динамического масива.

Code: Type. T2DBooleanArray = array of array of Boolean; Procedure Save2DBooleanArray(const A: T2DBooleanArray; S: TStream); Var. Writer: TWriter; I: Integer; Begin. Assert(Assigned(S)); Writer := TWriter.Create(S, 8096); Try. Writer.WriteInteger(Length(A)); For i := 0 to Length(A) - 1 do. Begin. Writer.WriteInteger(Length(A[i])); Writer.Write(A[i, 0], Length(A[i]) * sizeof(A[i, 0])); End; { For }. Finally. Writer.Free; End; { Finally }. End; Procedure Load2DBooleanArray(var A: T2DBooleanArray; S: TStream); Var. Reader: TReader; I, numrows, numcols: Integer; Begin. Assert(Assigned(S)); Reader := TReader.Create(S, 8096); Try. Numrows := reader.ReadInteger; SetLength(A, numrows); For i := 0 to numrows - 1 do. Begin. Numcols := reader.ReadInteger; SetLength(A[i], numcols); Reader.Read(A[i, 0], numcols * sizeof(A[i, 0])); End; { For }. Finally. Reader.Free; End; { Finally }. End;

Как сворачивать все приложение при сворачивании неглавного окна?

Code: Procedure WMActivateApp(var Msg: TWMActivateApp); message WM_ACTIVATEAPP; Procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; {©Drkb v.3(2007): www.drkb.ru}. ... 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;

Как сделать плавное закрытие окна ?

Работает в 2k/XP:

Code: Procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); {©Drkb v.3(2007): www.drkb.ru}. Begin. AnimateWindow(Handle, 500, AW_HIDE or AW_BLEND); End;

Как назначить событие на увеличение/уменьшение TSpinEdit с помощью стрелочек?

У TSpinEdit.Button есть дополнительные события, которые не показаны в инспекторе объектов, например, OnUpClick и OnDownClick...

Code: Unit Unit1; {©Drkb v.3(2007): www.drkb.ru}. Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin; Type. TForm1 = class(TForm). SpinEdit1: TSpinEdit; Procedure FormCreate(Sender: TObject); Public. Procedure OnButtonUpClick(Sender: TObject); End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Procedure TForm1.FormCreate(Sender: TObject); Begin. SpinEdit1.Button.OnUpClick := OnButtonUpClick; End; Procedure TForm1.OnButtonUpClick(Sender: TObject); Begin. MessageDlg('Up Button was clicked.', mtInformation, [mbOk], 0); End; End.

Как установить фокус на документе в TWebBrowser ?

WebBrowser1.SetFocus ставит фокус на компонент TWebBrowser, а это не всегда то, что нужно. Если нужно поставить фокус на документ в ТWеbВrоwsеr'е (чтобы, например, кнопки вверх/вниз скроллировали документ, а не ставили фокус на другой компонент), то можно использовать этот код:

Code: Uses ActiveX; With WebBrowser1 do. If Document <> nil then. With Application as IOleobject do. DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);

Отображение файлов в память.

Для работы с файлом динамической подкачки страниц виртуальной памяти в Windows 32 используется механизм отображения файлов в адресное пространство программы. Соответствующие функции API доступны любой программе и могут применяться к любому файлу (кстати, таким способом загружается в адресное пространство процесса исполняемый файл). В результате отображения программа может работать с файловыми данными как с данными, размещенными в динамической памяти. Такая возможность не только в большинстве случаев повышает скорость работы с данными, но и предоставляет программисту уникальные средства обработки сразу всех записей файла. Например, он может единственным оператором проверить входит ли заданный образец поиска в любую строку текстового файла. Отображение файла осуществляется в три приема.

Создание/открытие файла.

Вначале файл создается обращением к функции.

Function FileCreate(FileName: String): Integer;

Или открывается с помощью.

Function FileOpen(const FileName: String; Mode: LongWord): Integer;

В обеих функциях FileName - имя файла, возможно, с маршрутом доступа. Параметр Mode определяет режим доступа к файлу и может принимать одно из следующих значений: fmOpenRead - только чтение; fmOpenWrite - только Запись; fmOpenReadWrite - чтение и запись. с помощью операции or эти константы можно комбинировать с одной из следующих регулирующих совместный доступ к файлу нескольких Программ: fmShareExclusive - совместный доступ Запрещен; fmShareDenyWrite - Другим Программам запрещается запись; fmShareDenyRead - другим программам запрещается чтение; fmSchareDenyNone - совместный доступ неограничен. Обе функции возвращают дескриптор созданного (открытого) файла или 0, если операция оказалась неуспешной.

Создание объекта отображения.

На втором этапе создается объект отображения в память. Для этого используется такая функция:

Function CreateFileMapping(hFile: THandle; IpFileMapping-Attributes: PSecurityAttributes; flProtect, dwMaximumSize-High, dwMaximumSizeLow: DWord; IpName: PChar): THandle;

Здесь hFile - дескриптор файла; ipFileMappingAttributes - указа-тель на структуру, в которой определяется, может ли создаваемый объект порождать дочерние объекты (обычно не может - nil); flProtect -определяет тип защиты, применяемый к окну отображения файла (см.ниже); dwMaximumSizeHigh, dwMaximumSizeLow - соответственно Старшие и младшие 32 разряда размера файла; если вы будете отображать файлы длинной до 4 ГбаЙТ, поместите В dwMaximumSizeHigh 0, а В dwMaximumSizeLow - длину файла; если оба параметра равны 0, размер окна отображения равен размеру файла; ipName - имя объекта отображения или nil.

Параметр flProtect задает тип защиты, применяемый к окну просмотра файла, и может иметь одно из следующих значений: page_readonly - файл можно только читать (файл должен быть создан или открыт В режиме fmOpenRead); PAGE_READWRITE - файл можно читать и записывать в него новые данные (файл открывается в режиме fmOpenReadWrite); PAGE_WRITECOPY - файл открыт для записи и чтения, однако обновленные данные сохраняются в отдельной защищенной области памяти (отображенные файлы могут разделяться программами, в этом режиме каждая программа сохраняет изменения в отдельной области памяти или участке файла подкачки); файл открывается В режиме fmOpenReadWrite или fmOpenWrite; этот тип защиты нельзя использовать в Windows 95/98. С помощью операции or к параметру fiprotect можно присоединить такие атрибуты:

Sec_commit - выделяет для отображения физическую память или участок файла подкачки; sec_image - информация об атрибутах отображения берется из образа файла; sec_nocashe - отображаемые данные не кэшируются и записываются непосредственно на диск;

Sec_reserve - резервируются страницы раздела без выделения физической памяти. Функция возвращает дескриптор объекта отображения или 0, если обращение было неудачным.

Создание окна просмотра.

Наконец, на третьем этапе создается окно просмотра, т. е. собственно отображение данных в адресное пространство программы:

Function MapViewOfFile(hFileMappingObject: THandle; dwDesiresAccess: DWord; dwFileOffsetHigh, dwFileIffsetLow, dwNumberOfBytesToMap: DWord): Pointer;

Здесь hFileMappingObject -дескриптор объекта отображения; dwDesiresAccess - определяет способ доступа к данным и может иметь одно из следующих значений: file_map_write - разрешает чтение и запись, При ЭТОМ В функции CreateFileMapping должен использоваться атрибут page_readwrite; file_map_read - разрешает только чтение, в функции CreateFileMapping должен использоваться атрибут.

PAGE_READONLY или PAGE_READWRITE; FILE_MAP_ALL_ACCESS - тоь же, что и file_map_write; file_map_copy - данные доступны для записи и чтения, однако обновленные данные сохраняются в отдельной защищенной области памяти; в функции CreateFileMapping должен использоваться атрибут page_writecopy; dwFileOffsetHigh, dwFileIffsetLow -определяют соответственно старшие и младшие разряды смещения от начала файла, начиная с которого осуществляется отображение;

DwNumberOfBytesToMap - определяет длину окна отображения (0 - длина равна длине файла). Функция возвращает указатель на первый байт отображенных данных или nil, если обращение к функции оказалось неуспешным.

Освобождение ресурсов отображения.

После использования отображенных данных ресурсы окна отображения нужно освободить функцией function UnMapViewOfFile(IpBaseAddress: Pointer): BOOL; единственный параметр обращения к которой должен содержать адрес первого отображенного байта, т. е. адрес, возвращаемый функцией MapViewOfFile. Закрытие объекта отображения и самого файла осуществляется обращением к функции.

Function CloseHandle(hObject: THandle).

Пример использования.

Программа создает дисковый файл, состоящий из 100000 случайных вещественных чисел (длину файла можно выбрать другой, если изменить значение редактора длина массива). Файл с именем test.dat создается путем отображения файла в память (кнопка память) и традиционным способом (кнопка Файл). В обоих случаях показывается время счета (процессор 400 МГц, память 64 Мбайт). Чем больше частота и память, тем больше будет разница во времени.

Code: Unit Unit1; Interface. Uses. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Spin; Type. TFormI = class (TForm). BtMem: TButton; BtFile: TButton; Se: TSpinEdit; Labell: TLabel; Pb: TProgressBar; Label2: TLabel; IbMem: TLabel; IbFile: TLabel; Procedure btMemClick(Sender: TObject); Procedure btFileClick(Sender: TObject); Private. { Private declarations }. Public. { Public declarations }. End; Var. Form1: TForm1; Implementation. {$R *.DFM}. Procedure TForm1.btMemClick(Sender: TObject); // Создание файла методом его отображения. Type PReal = ^Real; Var. HFile, HMap: THandle; AdrBase, AdrReal: PReal; K: Integer; FSize: Cardinal; BegTime: TDateTime; Begin. BegTime := Time; // Засекаем время пуска. // Готовим ProgressBar: Pb.Max := se.Value; Pb.Position := 0; Pb.Show; FSize := se.Value * SizeOf(Real); // Длина файла HFile := FileCreate('test.dat'); // Создаем файл. If HFile = 0 then // Ошибка: возбуждаем исключение. Raise Exception.Create('Ошибка создания файла'); Try. // Отображаем файл в память HMap := CreateFileMapping( HFile, NIL, PAGE_READWRITE, 0, FSize, NIL); If HMap = 0 then // Ошибка: возбуждаем исключение. Raise Exception.Create('Ошибка отображения файла'); Try. // Создаем окно просмотра: AdrBase := MapViewOfFile( HMap, FILE_MAP_WRITE, О, О, FSize) ; If AdrBase = NIL then // Ошибка: возбуждаем исключение. Raise Exception.Create('Невозможно просмотреть файл'); // Сохраняем начальный адрес для правильной ликвидации. // окна просмотра: AdrReal := AdrBase; For k := 1 to se.Value do. Begin. AdrReal^ := Random; // Помещаем в файл новое число. // Перед наращиванием текущего адреса необходимо. // привести его к типу Integer или Cardinal: AdrReal := Pointer(Integer(AdrReal) + SizeOf(Real)); IbMem.Caption := IntToStr(k); Pb.Position := k; Application.ProcessMessages; End; // Освобождаем окно просмотра: UnmapViewOfFile(AdrBase) finally. // Освобождаем отображение CloseHandle(HMap). End. Finally. // Закрываем файл CloseHandle(HFile). End; // Сообщаем время счета pb.Hide; IbMem.Caption := TimeToStr(Time-BegTime). End; Procedure TFormI.btFileClick(Sender: TObject) ; // Создание файла обычным методом var. F: File of Real; K: Integer; BegTime: TDateTime; R: Real; // Буферная переменная для обращение к Write. Begin. BegTime := Time; // Засекаем начальное время счета // Готовим ProgressBar: Pb.Max := se.Value; Pb.Position := 0; Pb.Show; // Создаем файл: AssignFile(F, 'test.dat'); Rewrite(F); For k := 1 to se.Value do. Begin. R := Random; // Параметрами обращения к Write. Write(F, R); // могут быть только переменные. IbFile.Caption := IntToStr(k); Pb.Position := k; Application.ProcessMessages; End; CloseFile(F) ; Pb.Hide; IbFile.Caption :=TimeToStr(Time-BegTime). End; End.

Арифметика.

Abs Возвращает абсолютное значение аргумента.

Ceil Округляет значение аргумента в большую сторону.

Exp Вычисляет значение ex.

Floor Округляет значение аргумента в меньшую сторону.

Frac Возвращает дробную часть аргумента.

Frexp Возвращает мантиссу и экспоненту аргумента.

Int Возвращает целую часть аргумента.

IntPower Возводит аргумент X в целочисленную степень Y.

Ldexp Вычисляет X*2Y.

Ln Вычисляет натуральный логарифм ln(x).

LnXP1 Вычисляет натуральный логарифм ln(x+1).

Log10 Вычисляет десятичный логарифм.

Log2 Вычисляет логарифм аргумента по основанию 2.

LogN Вычисляет логарифм аргумента по основанию N.

Max Возвращает большее из двух чисел.

Min Возвращает меньшее из двух чисел.

Pi Возвращает значение числа Пи.

Poly Вычисляет однородный полином.

Power Возводит X в степень Y.

Round Округляет число к ближайшему целому.

Sqr Вычисляет квадрат аргумента Х.

Sqrt Вычисляет квадратный корень аргумента Х.

Trunc Отсекает дробную часть числа.

©Drkb::00313.

Взято с http://atrussk.ru/delphi/

Тригонометрические функции и процедуры.

ArcCos Вычисляет арккосинус аргумента.

ArcCosh Вычисляет гиперболический арккосинус аргумента.

ArcSin Вычисляет арксинус аргумента.

ArcSinh Вычисляет гиперболический арксинус аргумента.

ArcTan Вычисляет арктангенс аргумента.

ArcTan2 Вычисляет arctg(Y/X).

ArcTanh Вычисляет гиперболический арктангенс аргумента.

Cos Вычисляет косинус аргумента.

Cosh Вычисляет гиперболический косинус аргумента.

Cotan Вычисляет котангенс аргумента.

Hypot Вычисляет длину гипотенузы прямоугольного треугольника.

Sin Вычисляет синус аргумента.

SinCos Вычисляет одновременно синус и косинус аргумента.

Sinh Вычисляет гиперболический синус аргумента.

Tan Вычисляет тангенс аргумента.

Tanh Вычисляет гиперболический тангенс аргумента.

Преобразование тригонометрических единиц измерений.

CycleToRad Преобразовывает значение аргумента из циклов в радианы.

DegToRad Преобразовывает значение аргумента из градусов в радианы.

GradToRad Преобразовывает значение аргумента из десятичных градусов (grad) в радианы.

RadToCycle Преобразовывает значение аргумента из радианов в циклы.

RadToDeg Преобразовывает значение аргумента из радианов в градусы.

RadToGrad Преобразовывает значение аргумента из радианов в десятичные градусы (grad).

©Drkb::00314.

Взято с http://atrussk.ru/delphi/

Операции над числовыми массивами.

MaxIntValue Возвращает наибольшее значение целочисленного массива.

MaxValue Возвращает наибольшее значение числового массива.

Mean Вычисляет среднее арифметическое всех значений массива.

MeanAndStdDev Вычисляет среднее арифметическое всех значений массива, и среднее отклонение.

MinIntValue Возвращает наименьшее значение целочисленного массива.

MinValue Возвращает наименьшее значение числового массива.

MomentSkewKurtosis Вычисляет среднее значение, дисперсию, отклонение и периодичность.

Norm Возвращает Евклидову норму для всех значений массива.

PopnStdDev Вычисляет среднеквадратичное отклонение для совокупности данных.

PopnVariance Вычисляет дисперсию совокупности данных.

StdDev Вычисляет стандартное среднеквадратичное отклонение элементов массива.

Sum Вычисляет сумму значений всех элементов числового массива.

SumInt Вычисляет сумму значений всех элементов целочисленного массива.

SumOfSquares Вычисляет сумму квадратов всех элементов числового массива.

SumsAndSquares Возвращает сумму элементов и сумму квадратов всех элементов числового массива.

TotalVariance Вычисляет статистическую дисперсию.

Variance Вычисляет типовую дисперсию всех значений массива.

©Drkb::00248.

Взято с http://atrussk.ru/delphi/

Функции и процедуры для работы с данными перечислимого типа.

Dec Уменьшает значение переменной на заданную величину.

Inc Увеличивает значение переменной на заданную величину.

Odd Определяет четность аргумента.

Ord Возвращает порядковый номер выражения перечислимого типа или код ASCII выражения символьного типа.

Pred Возвращает значение, предшествующее аргументу.

Succ Возвращает значение, следующее за аргументом.

©Drkb::00261.

Взято с http://atrussk.ru/delphi/

Функции и процедуры для финансовых вычислений.

DoubleDecliningBalance Вычисляет амортизационные отчисления на определенном этапе.

FutureValue Вычисляет значение вклада через определенный период времени.

InterestPayment Вычисляет процентную ставку кредита.

InterestRate Вычисляет процентную ставку инвестиций.

InternalRateOfReturn Вычисляет внутреннюю ставку дохода от инвестиций.

NetPresentValue Вычисляет текущее значение платежа, используя массив с расчетными значениями.

NumberOfPeriods Вычисляет количество этапов необходимое для погашения кредита.

Payment Вычисляет полную сумму погашения кредита на отдельном этапе.

PeriodPayment Вычисляет необходимую сумму выплат основной части (без процентов) кредита на определенном этапе.

PresentValue Определяет текущее значение вклада.

SLNDepreciation Вычисляет сумму амортизационных отчислений по методу равномерной амортизации.

SYDDepreciation Вычисляет сумму амортизационных отчислений по методу ускоренной амортизации.

©Drkb::00315.

Взято с http://atrussk.ru/delphi/

Функции для работы с памятью.

Addr Возвращает указатель на объект.

AllocMem Выделяет на куче блок памяти заданного размера, заполняет его нулями и возвращает указатель на начало блока.

CompareMem Выполняет бинарное сравнение двух участков памяти.

GetHeapStatus Возвращает текущее состояние диспетчера памяти.

GetMemoryManager Возвращает значения указателей полей текущего диспетчера памяти.

IsMemoryManagerSet Определяет, используется в настоящий момент диспетчер памяти, установленный по умолчанию, или был установлен другой диспетчер.

Ptr Возвращает указатель на адрес памяти, переданный в качестве аргумента.

SizeOf Возвращает размер памяти, занимаемый переменной.

SetMemoryManager Устанавливает значения полей диспетчера памяти.

SysFreeMem Высвобождает память, используемую динамической переменной.

SysGetMem Выделяет блок памяти заданного размера и возвращает указатель на него.

SysReallocMem Изменяет размер динамически распределенного блока памяти.

©Drkb::02072.

Взято с http://atrussk.ru/delphi/

Функции и процедуры управления мышью.

Функция FindVCLWindow( const Pos: TPoint ): TWinControl;

Функция возвращает оконное средство управления для местоположения, определенного параметром Pos. Если для данного местоположения нет оконных средств управления, то функция возвращает nil.

Функция GetCaptureControl: TControl;

Функция возвращает средство управления класса TControl, которое получает в текущий момент все сообщения от мыши.

Функция SetCaptureControl( Control: TControl );

Функция передает управление мышью средству управления, определенному в параметре Control. Данное средство управления будет получать все сообщения от мыши, пока управление мышью не будет передано другому средству управления с помощью функции SetCaptureControl или функцией ReleaseCapture Windows API.

©Drkb::01603.

Взято с http://atrussk.ru/delphi/

Функции и процедуры для работы с drag-and-drop операциями.

CancelDrag Отменяет текущую drag-and-drop или drag-and-dock операцию.

Функция FindDragTarget (const Pos: TPoint;AllowDisabled: Boolean ): TControl;

Функция возвращает объект базового класса TControl, к которому относится позиция экрана с координатами, определенными параметром Pos. Данная функция используется для определения потенциального получателя drag-and-drop или drag-and-dock операции. Если для указанной позиции не существует никакого оконного средства управления, то функция возвращает nil. Параметр AllowDisabled определяет, будут ли учитываться заблокированные (disabled) объекты.

Функция IsDragObject( Sender: TObject ): Boolean;

Функция определяет, является ли объект, определенный в параметре Sender, потомком класса TDragObject. Данную функцию можно использовать в качестве параметра Source в обработчиках событий OnDragOver и OnDockOver для того, чтобы определить будет ли принят перетаскиваемый объект. Также функцию IsDragObject можно использовать в качестве параметра Source в обработчиках событий OnDragDrop и OnDockDrop для того, чтобы правильно интерпретировать перетаскиваемый объект.

©Drkb::00371.

Взято с http://atrussk.ru/delphi/

Функции и процедуры для работы с курсором.

Функция CursorToIdent (Cursor: Longint;var Ident: string): Boolean;

Функция возвращает строковое значение предопределенной константы, определяющее вид курсора. Числовое значение, определяющее вид курсора, передается в параметре Cursor. Строковое значение константы возвращается в параметре Ident. Если для указанного числового значения, определяющего вид курсора, есть соответствующая строковая константа, то функция возвращает True, а иначе - False.

На практике возникают ситуации, когда необходимо, чтобы функция возвращала в результате строковое значение даже в том случае, когда для числового значения вида курсора, нет предопределенной строковой константы. В данных ситуациях используйте функцию CursorToString.

Функция CursorToString( Cursor: TCursor ): string;

Type TCursor = -32768...32767;

Функция возвращает строковое значение константы или числа, соответствующих указанному виду курсора. Числовое значение, определяющее вид курсора, передается в параметре Cursor. Если указанному значению соответствует предопределенная строковая константа, то функция возвращает имя этой константы, иначе возвращается строковое представление значения переданного в параметре Cursor.

Процедура GetCursorValues( Proc: TGetStrProc );

Type TGetStrProc = Procedure( const S: string ) of Object;

Процедура передает каждое предопределенное в VCL имя курсора (значение предопределенной строковой константы, определяющей вид курсора) процедуре повторного вызова Proc.

Функция IdentToCursor (const Ident: string;var Cursor: Longint ): Boolean;

Функция возвращает числовое значение, соответствующее строковой константе, определяющей вид курсора. Строковое значение передается в параметре Ident. Числовое значение возвращается в переменной Cursor. При успешном выполнении функция возвращает True, а если значение Ident не является предопределенной константой, то функция возвращает False.Данная функция обратна по функциональности функции CursorToIdent.

Функция StringToCursor( const S: string ): TCursor;

Type TCursor = -32768...32767;

Функция преобразовывает строковое значение S, определяющее вид курсора, в значение типа TCursor. Функция обратна по функциональности функции CursorToString. Параметр S должен представлять собой либо предопределенную константу вида курсора, либо строковое представление соответствующего ему числового значения, в противном случае возникнет исключение EConvertError.

Code: Var. I1,I2: Longint; Begin. I1:= StringToCursor('crHelp'); // I1:= -20. I2:= StringToCursor('-20'); // I2:= -20. End;

Поддержка процедур завершения программы.

Процедура AddTerminateProc( TermProc: TTerminateProc);

Добавляет процедуру в системный список процедур "завершения программы" (termination procedures list), которые вызываются перед окончанием работы приложения. Каждая такая процедура должна возвращать True, когда приложение может быть беспроблемно завершено или False, если приложение не должно быть завершено. Если любая из указанных процедур возвращает False, то выполнение приложения завершено не будет.

Функция CallTerminateProcs: Boolean;

Функция вызывает все подпрограммы, указанные в списке процедур завершения программы (termination procedures list). Если все процедуры и функции списка возвращают True, то CallTerminateProcs возвращает True, в остальных случаях функция возвращает False. Функция CallTerminateProcs вызывается внутренне непосредственно перед завершением выполнения приложения.

©Drkb::02069.

Взято с http://atrussk.ru/delphi/

Краткий словарь терминологии CORBA.

AM Asynchronous Messaging. Служба асинхронного обмена сообщениями.

Application Object Прикладной объект. Представляет собой реализацию объекта для конкретного приложения.

BOA Basic Object Adapter. Адаптер, обеспечивающий доступ к сервисам брокера объектных запросов (ORB).

CORBA Component Object Request Broker Architecture. Архитектура брокеров объектных запросов. Объектная архитектура для создания сложных распределенных объектных программных систем.

CORBA domains Доменные объекты CORBA.

CORBA facilities Общие средства реализаций объектов, необходимых для большого числа приложений. Например, поддержка потоков заданий.

CORBA service Объектная служба CORBA (служба событий, служба транзакций, служба имен и т.д.).

DII Dynamic Invocation Interface. Интерфейс динамического вызова. Применяется для подключения объектов, не известных на момент компиляции приложения.

GIOP General Inter ORB Protocol. Протокол, посредством которого взаимодействуют между собой различные брокеры объектных запросов (ORB).

IDL Interface Definition Language. Язык описания интерфейсов, разработанный консорциумом OMG.

IIOP Internet Inter ORB Protocol. Реализация протокола GIOP на базе TCP/IP.

INS Interoperable Naming Service. Служба имен, предназначенная для прозрачного поиска и вызова объектов, не зависящих от конкретной реализации ORB.

Implementation Repository Репозитарий Реализаций. Архив, содержащий информацию о серверах приложений CORBA.

Interface pointer Указатель на интерфейс объекта. С его помощью клиент получает доступ к объекту.

Interface Repository Репозитарий интерфейсов. Архив, содержащий, написанные на IDL определения типов данных и интерфейсов.

Object reference Объектная ссылка. Служит для идентификации объекта в сети.

OMA Object Management Architecture. Составная часть технологии CORBA. Представляет собой базовую архитектуру, опубликованную в 1992 году. Определяет четыре категории объектов: CORBAservices, CORBAfacilities, объекты CORBAdomain и прикладные объекты. С момента разработки и до сегодняшнего дня в архитектуру были внесены лишь незначительные изменения.

OMG Object Management Group. Консорциум компаний образованный в апреле 1989 года, разработчик технологии и спецификаций CORBA. В состав данного консорциума входят около 800 компаний. Адрес сервера консорциума http://www.omg.org.

ORB Object Request Broker (Брокер объектных запросов). Ядро архитектуры CORBA. Объектная шина для взаимодействия локальных и удаленных объектов. Отвечает за вызов удаленного объекта, поиск экземпляра объекта, его подготовку к получению и обработке запроса, передачу запроса и доставку результатов клиенту.

OTS Object Transaction Service. Сервис управления транзакциями CORBA.

POA (Portable Object Adapter) - Переносимый объектный адаптер. Представляет собой более позднюю спецификацию BOA, в отличие от BOA, позволяет переносить серверные компоненты архитектуры с одного ORB на другой.

PSS Persistent State Service. Новая реализация службы долговременного хранения объектов (persistent) в спецификации CORBA 3.0.

RPC Remote procedure call. Вызов удаленной процедуры. Реализует схему передачи сообщений, в соответствии с которой клиент передает сообщение с параметрами вызова по сети удаленной серверной процедуре, а результаты ее выполнения возвращается клиенту в другом сообщении.

Server Stub Серверный суррогат. Тоже, что и Skeleton.

Skeleton Server Stub. Серверный суррогат. Для вызова какой-либо функции клиент через клиентский суррогат обращается к серверному суррогату. Клиентский суррогат упаковывает аргументы функции в сообщение и передает их посредством RPC серверному суррогату. Серверный суррогат распаковывает полученное сообщение, вызывает требуемую функцию или метод объекта. Клиент и сервер могут работать в различных языковых и операционных средах, по этому на клиентский суррогат возложена обязанность преобразования аргументов, а на серверный суррогат преобразование результатов функций в универсальное, не зависящее от конкретной архитектуры представление.

UML Unified Modeling Language. Язык CORBA. Используется для описания и разработки распределенных программных систем с помощью специальных диаграмм.

UUID Универсальный уникальный идентификатор. Используется для идентификации интерфейсов.

©Drkb::04355.

Взято с http://atrussk.ru/delphi/

От переводчика.

Это одна из двух книг посвященных генератору отчетов Rave Reports.

Главы «Лицензия на одного пользователя» и «Ограниченные гарантии» оставлены без перевода.

Поскольку у меня нет самого RAVE, то возможно местами качество перевода будет не совсем адекватное, поскольку невозможно проверить, что действительно кроется за тем или другим пунктом документации. Основной проблемой остались термины tab и tab box. Как я понял из текста tab и tab box это регионы на отчете, имеющие свои позиции и характеристики, очень похожие на табулированные позиции, табулоскопы, отсюда и слово tab. Кроме того, tab box может иметь рамки и тени и очень похож на блоки текста Ворда, с другой стороны есть аналогия и с ячейками Экселя. У них также есть различие в выравнивании. По этому у меня сложилось впечатление, что это аналогичное таблоскопам, блокам текста, к тому же хорошо реагирующее на символы табуляции, но возможно я ошибаю, так как у меня нет возможности проверить это на практике. В руководсте пользователя нет никаких намеков на это и даже упоминания об этом. Поэтому везде в тексте, где Вы встретите слово таб или таб с рамками, знайте, что речь идет именно об этих табах.

Также смутный термин [paper] sectio/n, написано о нем вскользь и очень невнятно.

По поводу замеченных недостатков и опечаток, просьба сообщать на e-mail anatoly@podgoretsky.com.

Начало работы - Техническая информация.

Лицензия на одного пользователя - Single User License Agreement.

This is a legal Agreement between you, as the end user, and Nevrona Designs. By opening the enclosed sealed disk package, or by using the disk, you are agreeing to be bound by the terms of this Agreement. If you do not agree with the terms of this Agreement, promptly return the unopened disk package and accompanying items, (including written materials), to the place you obtained them for a full refund.

1. Grant of License - Nevrona Designs grants to you the right to use one copy of the enclosed Nevrona Designs program, (the Software), on a single terminal connected to a single computer (i.e. CPU). You may make one copy of the Software for back-up purposes for use on your own computer. You must reproduce and include the copyright notice on the back-up copy. You may not network the Software or use it on more than a single computer or computer terminal at any time, unless a copy is purchased for each computer or terminal on the network that will use the Software. You may transfer this Software from one computer to another, provided that the Software is used on only one computer at a time. You may not rent or lease the Software, but you may transfer the Software and accompanying written material and this license to another person on a permanent basis provided you retain no copies and the other person agrees to accept the terms and conditions of this Agreement. THIS SOFTWARE MAY NOT BE DISTRIBUTED, IN MODIFIED OR UNMODIFIED FORM, AS PART OF ANY APPLICATION PROGRAM OR OTHER SOFTWARE THAT IS A LIBRARY-TYPE PRODUCT, DEVELOPMENT TOOL OR OPERATING SYSTEM, OR THAT MAY BE COMPETITIVE WITH, OR USED IN LIEU OF, THE PROGRAM PRODUCT, WITHOUT THE EXPRESS WRITTEN PERMISSION OF NEVRONA DESIGNS. This license does include the right to distribute applications using the enclosed software provided the above requirements are met.

2. Term - This Agreement is effective until you terminate it by destroying the Software, together with all copies. It will also terminate if you fail to follow this agreement. You agree upon termination to destroy the Software, together with all copies thereof.

3. Copyright - The software is owned by Nevrona Designs and is protected by United States laws and international treaty provisions. Therefore, you must treat the Software like any other copyrighted material (e.g. a book or musical recording) EXCEPT that you may either (a) make one copy of the Software solely for back-up or archival purposes, or (b) transfer the Software to a single hard disk provided you keep the original solely for back-up or archival purposes. You may not copy the written materials accompanying the Software.

Ограниченная гарантия - Limited Warranty.

1. Limited Warranty - Nevrona Designs warrants that the disks on which the Software is furnished to be free from defects in material and workmanship, under normal use, for a period of 90 days after the date of the original purchase. If, during this 90-day period, a defect in the disk should occur, the disk may be returned with proof of purchase to Nevrona Designs, which will replace the disk without charge. Nevrona Designs warrants that the Software will perform substantially in accordance with the accompanying written materials. Nevrona Designs does not warrant that the functions contained in the Software will meet your requirements, or any operation of the Software will be uninterrupted or error-free. However, Nevrona Designs will, after being notified of significant errors during the 90-day period, correct demonstrable and significant Software or documentation errors within a reasonable period of time, or refund all or a fair portion of the price you have paid for the Software at Nevrona Designs' option.

2. Disclaimer of Warranties - Nevrona Designs disclaims all other warranties, either expressed or implied, including but not limited to implied warranties of merchantability of fitness from particular purpose, with respect to the Software and accompanying written materials. This limited warranty gives you specific legal rights, you may have others, varying from state to state. Nevrona Designs will have no consequential damages. In no Событие, shall Nevrona Designs or its suppliers be liable for damages whatsoever, (including without limitation, damages for loss of business profits, business interruption, loss of business information, or any pecuniary loss), arising out of the use or the inability to this Nevrona Designs product, even if Nevrona Designs has been advised of the possibility of such damages. Some states do not allow the exclusion of limitation of liability for consequential or incidental damages, and this limitation may not apply to you.

3. Sole Remedy - Nevrona Designs' entire liability in your inclusive remedy shall be, at Nevrona Designs' option, either: (1) The return of the purchase price paid; or (2) Repair or replacement of the Software that does not meet Nevrona Designs' limited warranty, which is returned to Nevrona Designs with a copy of your receipt.

4. Governing Law - This Agreement will be consTRUEd and governed in accordance with laws of the State of Arizona.

5. U.S. Government Restricted Rights - This Software and documentation are provided with restrictive rights. Use, duplication or disclosure by the Government is subject to restrictions set forth in Section c(1)(ii) of the Rights and Technical Data in Computer Software clause at 52.227-7013.

Техническая поддержка.

Техническая поддержка, обновления и другая информация, относящаяся к Rave Reports, может быть получена на сайте Nevrona Designs. Для получения более подробной информации посетите один из слежующих сайтов:

Техническая поддержка - http:/www.nevrona.com/support.

Добавления, советы и другая информация - http:/www.nevrona.com/rave.

Обновления - http:/www.nevrona.com/rave/download.html.

Введение в Rave.

Панель компонент Rave.

Имеются два типа объектов в Rave, компоненты вывода (Output Components) и классы отчета (Report Classes). Компоненты вывода отвечают за вывод отчета на различные устройства вывода, а классы отчета, которые не являются компонентными классами, отвечают за все остальные задачи.

TrvSystem Включает в себя стандартный принтер и предварительный просмотр и является одним из самых простых в использовании компонент.

TRvNDRWriter Создает NDR поток или файл (в должном формате) при выполнении отчета.

TrvRenderPreview Показывает диалог предварительного просмотра для NDR потока или файла.

TrvRenderPrinter Посылает NDR поток или файл на принтер.

TRvRenderPDF Преобразовывает NDR поток или файл в PDF формат.

TRvRenderHTML Преобразовывает NDR поток или файл в HTML формат.

TRvRenderRTF Преобразовывает NDR поток или файл в RTF формат.

TRvRenderText Преобразовывает NDR поток или файл в Text формат.

Классы Rave.

TrvProject Производит соединение к проекту отчета, который был создан с помощью визуального редактора Rave. Используйте данный компонент для получения списка всех доступных отчетов или для выполнения конкретного отчета.

TrvCustomConnection Подсоединяет пользовательские данные (сгенерированные через события) к DirectDataViews, созданные с помощью визуального редактора Rave.

TrvDataSetConnection Подсоединяет TDataSet данные (например, TClientDataSet, или компоненты третьих сторон, наследники от TDataSet) к DirectDataViews, созданные с помощью визуального редактора Rave.

TrvTableConnection Подсоединяет TTable компоненты к DirectDataViews, созданные с помощью визуального редактора Rave.

TrvQueryConnection Подсоединяет TQuery компоненты к DirectDataViews, созданные с помощью визуального редактора Rave.

Начало работы с Rave.

Добро пожаловать в RAVE!

RAVE (Report Authoring Visual Environment) это визуальная часть RAVE. Данное руководство позволит Вам, за минимальное количество шагов, быстро создать, с помощью редактора RAVE, ваш первый визуальный отчет и затем краткий обзор, что делает проект отчетов RAVE. Так что приступаем.

1) Запустите Delphi и создайте новое приложение.

2) Создайте TTable, TQuery или другие наследники от TDataSet и инициализируйте их к правильной таблице. Установите свойство Active всех компонент в TRUE и убедитесь, что все остальные свойства также выставлены корректно.

3) Создайте компонент TRvDataSetConnection (расположен на закладке Rave) и установите свойство DataSet к компоненту базы данных, который вы создали на шаге 2. Смените имя этого нового компонента на "TutorialCXN".

4) Создайте компонент (расположен на закладке Rave). Сделайте двойной щелчок на компоненте или по правой кнопке мыши выберите "Rave Visual Designer", что запустит визуальный дизайнер.

5) После того как визуальный дизайнер Rave закончит свою загрузку, выберите Project | New Data Object из главного меню для выбора диалога Data Connections. Выберите Direct Data View и затем Next. Убедитесь, что выбран элемент TutorialCXN в списке Active Data Connections и нажмите кнопку OK.

6) Перейдите в дерево проекта (Locate the Project Tree - дерево в левой части визуального дизайнера) и откройте Data View Dictionary. Выберите новый просмотр данных, DataView1, который только что был создан. Использую панель свойств (расположена ниже дерева проекта), смените имя DataView1 на TutorialDV, свойство Name.

7) Теперь мы готовы к созданию отчета. Выберите Tools | Report Wizards | Simple Table из главного меню для вызова мастера построения Simple Table. Убедитесь, что выбран элемент TutorialDV и нажмите кнопку Next для продолжения. Выберите 2 или 3 поля из списка и для продолжения нажмите кнопку Next. Установите желаемый порядок полей, и для продолжения нажмите кнопку Next. Смените заголовок отчета, для описания назначения данного отчета и нажмите кнопку Next для продолжения. Установите желаемые размеры шрифтов, затем нажмите кнопку Generate для создания отчета.

8) Для предварительного просмотра данного отчета, выберите Project | Execute Report для вызова диалога Report Setup. Выберите "Preview" и нажмите кнопку OK. Вы должны увидеть ваш отчет.

9)

Поздравляем! Вы только что создали ваш первый Rave отчет. Следующий список показывает, что типично делает приложение с помощью Rave:

Структура Rave.

1) Компоненты доступа к данным – Как было сказано ранее, Rave использует данные из вашего приложения. Стандартные компоненты для доступа к данным, TRvCustomConnection, TrvDataSetConnection и TRvTableConnection представляют собой мост между данными вашего приложения и визуальными компонентами Rave. Компонент TrvCustomConnection может быть использован для доступа к данным не баз данных, таких как массивы или двоичные записи. Компонент TRvDataSetConnection может быть использован для доступа к наследникам TdataSet, включая компоненты третьих сторон. TrvTableConnection специально с компонентом TTable или его наследниками. Более детальное рассмотрение использования компонент доступа рассматривается в следующей главе.

2) Компонент TRvProject – данный компонент предоставляет доступ к отчетам и их компонентам. Компонент TRvProject имеет много свойств и методов, которые позволяют вам создавать, модифицировать и проектировать ваши проекты отчетов, будет рассмотрен в более поздних главах. Обычно вам требуется только один компонент TrvProject на приложение, но нет ограничения, что бы иметь их больше. Более подробно об использовании компоненты TRvProject будет сделана в следующих главах.

3) Файл проекта отчетов (.RAV) - файл проекта отчетов, в котором хранятся определения проекта, создается визуальным дизайнером отчетов Rave. Это двоичный файл, подобный файлу .DFM Delphi. Все отчеты, глобальные страницы и данные просмотров для проекта записываются в единственный файл. Вы можете экспортировать и импортировать элементы из файла или в файл проекта. Используя методы компоненты TRvProject, Вы можете также записывать файл проекта в поле базы данных, типа blob или в другое место.

4) Reports – библиотека (Report Library) страниц отчета проекта. Отчет Rave создает страницы отчета и визуальные компоненты на данных страницах. Вы можете создать столько определений страниц, сколько пожелаете, и объединять их большим количеством различных методов.

5) Global Pages – глобальные страницы записываются в каталог глобальных страниц проекта. Компоненты на глобальных страницах, в отличие от страниц отчета, видны во всех отчетах. Глобальные страницы служат для хранения шаблонов, которые отражаются в других страницах отчета.

6) Data Views – представления данных (Data views) записываются в словарь представлений (Data View Dictionary) проекта. Представления предоставляют интерфейс к компонентам доступа. При создании нового представления, вы должны иметь активный компонент доступа, или в работающем приложении, или на загруженной Delphi или C++Builder форме. Просмотры затем запрашивают компоненты доступа к данным для получения мета информации о данные, такой как - имена полей, типы данных и т.д. Компоненты полей содержатся внутри каждого представления, позволяя установку свойств для каждой колонки данных.

Rave подключения данных.

Мост к данным.

Как было отмечено ранее, подключения данных (data connections) предоставляют мост между данными в вашем приложении и Rave отчетом. Первая вещь, которую вы должны сделать, это выбор типа подключения данных. Определяется это типом компонентов баз, которые Вы используете. Ниже приведенная таблица поможет вам сделать выбор, какой тип подключения лучше использовать:

Компонент подключения данных: TRvCustomConnection.

Лучшее использовать с: Массивы, обычне файлы или не TDataSet компоненты.

Как подключить: Определить события, такие как OnFirst, OnNext, OnEOF, OnGetCols и OnGetRow.

Компонент подключения данных: TRvDataSetConnection.

Лучшее использовать с: Наследники TDataSet от третьих сторон.

Как подключить: Установите свойство DataSet соответствующему компоненту TDataSet.

Компонент подключения данных: TRvTableConnection.

Лучшее использовать с: TTable, заменитель TTable или его наследники.

Как подключить: Установить свойство Table компоненты.

Об именовании компонент подключения данных.

Свойство Name компоненты подключения данных используется для именования подключения. Очень важно использовать уникальные имена для ваших компонент подключений, поскольку не может быть дублирования в вашем приложении. Также является хорошей практикой использование уникальных идентификатор в имени подключения, поскольку все подключения данных видны во всех других приложениях. Например, если ваше приложение называется Wizbang Object Wizard, то вы можете предварять имена префиксом WOW в каждом подключении, что бы имена ваших подключений были уникальными.

Управление видимостью подключения.

Свойство Visible компоненты подключения данных используется для управления видимостью подключения для других приложений или версий визуального дизайнера, поставляемых конечному пользователю. Значение по умолчанию FALSE означает, что подключение данных будет видно только в отчете, печатаемом из того же самого приложения или из поставляемой программистом версии визуального дизайнера Rave. Значение TRUE означает, что подключения будут видны любому отчету, запущенному из любого приложения или из пользовательской версии дизайнера Rave. Хотя подключения данных видны в дизайнере конечного пользователя, они не показываются при попытке создать новое представление данных, поскольку они принадлежат приложению, запустившим данный дизайнер. Если Вы желаете сделать подключение из другого приложения доступным конечному пользователю, то лучшим методом будет создание проекта отчета с программисткой версией визуального дизайнера, в которой будут уже определены представления для внешних подсоединений данных.

Пользовательские подключения данных.

В будущем, могут появиться и другие пользовательские подключения данных, написанные специально для других компонент баз данных. Смотри подробности в файле CUSTOMDB.TXT, который находится в папке с исходными текстами.

Настройка подключений данных.

Использование событий для настройки ваших подключений данных.

Вы можете управлять, как данные будут поступать в ваш отчет через события компонент подключения данных. Для данных, поступающих не из баз, используйте компонент TrvCustomConnection, Вы можете предоставить доступ к вашим данным через его события. Для подключения данных из баз, используйте компоненты, такие как TRvDataSetConnection, достаточно будет переписать событие OnValidateRow. События подключений данных следующие:

Событие Описание.

OnEOF Вызывается, когда Rave желает определить, достигнут ли конец данных. При отсутствии данных требуется вернуть значение TRUE, если больше нет строк или если вызов события OnNext был сделан за пределы последней строки.

OnFirst Вызывается, когда Rave желает, что бы курсор был перемещен на первую строку данных. С развитой системой буферизации Rave, это событие обычно возникает только раз в начале сессии данных.

OnGetCols Вызывается, когда Rave желает получить мета данные. Это включает в себя имена полей, типы, размеры символов, полные имена и описание. Подробности смотри ниже.

OnGetRow Вызывается, когда Rave желает получить данные для текущей строки. Подробности смотри ниже.

OnGetSorts Вызывается, когда Rave желает получить доступные методы сортировки.

OnNext Вызывается, когда Rave желает переместить курсор на следующую строку.

OnOpen Вызывается, когда Rave желает инициализировать начало сессии. Должно быть сохранено текущее состояние, что бы потом его можно было восстановить в событии OnRestore.

OnRestore Вызывается, когда Rave желает восстановить состояние предыдущей сессии, которое было перед ее открытием.

OnSetFilter Вызывается, когда Rave желает фильтровать данные, такие как Master-Detail отчеты.

OnSetSort Вызывается, когда Rave желает сортировать данные. Подробности смотри ниже.

OnValidateRow Вызывается для каждой строки, позволяя тем сам управлять фильтрацией данных. Для пользовательских приложений, данное событие обычно не нужно, поскольку фильтрация данных через событие OnNext более эффективно. Тем не менее, данное событие очень полезно для других, более автоматизированных подключений, таких как TRvDataSetConnection. Подробности смотри ниже.

ПРИМЕЧАНИЕ:

Компонент TRvCustomConnection имеет свойства DataIndex и DataRows типа integer. Они предназначены для использования в событиях пользовательских подключений и если используются, то могут быть определены в OnFirst, OnNext и OnEOF событиях. DataIndex используется как позиция курсора, первая строка имеет номер 0. DataRows используется как счетчик строк данных. Например, если вы определяете пользовательское подключение к массиву данных, вам будет достаточно установить свойство Connection.DataRows равным количеству элементов в массиве и затем позволить Rave управлять OnFirst, OnNext и OnEOF событиями. В событии OnGetRow, Вы должны, обратиться к свойству Connection.DataIndex для определения какой элемент массива требуется вернуть назад (не забывайте, что нумерация идет с 0).

Событие OnGetCols.

Событие OnGetCols вызывается, когда Rave желает получить мета данные. Внутри этого события Вы захотите вызвать метод Connection.WriteField для каждого поля (колонки) ваших данных. Определение WriteField следующее:

Procedure WriteField(Name: string;DataType: TRpDataType;Width: integer;

FullName: string;Description: string);

Name это короткое имя поля и должно состоять только из алфавитно-цифровых символов. DataType это тип данных поля и должен быть одним из следующих типов: dtString, dtInteger, dtBoolean, dtFloat, dtCurrency, dtBCD, dtDate, dtTime, dtDateTime, dtBlob, dtMemo или dtGraphic. Width это относительная ширина поля в символах. Full name это полное, более описательное имя поля и может включать в себя пробелы и другие не алфавитно-цифровые символы. Если FullName пустое, то будет использовано короткое имя поля. Description это полное описание поля и обычно редактируется с помощью компонента, поэтому может состоять из нескольких строк. Используйте свойство Description для описания, как используется поле или для любой другой более, нужной информации насчет данного поля.

Пример:

Code: Procedure TDataForm.CustomCXNGetCols(Connection: TRvCustomConnection); Begin. With Connection do begin. WriteField('Index',dtInteger,8,'Index Field','Описание 1'); WriteField('Name',dtString,30,'Name Field','Описание 2'); WriteField('Amount',dtFloat,20,'Amount Field','Описание 3'); End; { with }. End;

Компоненты вывода.

Описание TRvRenderPreview.

Компонент TRvRenderPreview берет файл, созданный компонентом TRvNDRWriter и посылает его на экран для просмотра. TRvRenderPreview имеет много методов и событий, которые позволяют программисту создавать сложный, настраиваемый пользовательский интерфейс.

Свойства TRvRenderPreview.

ScrollBox определяет компонент TscrollBox, на котором и рисуется отчет.

FileName и StreamMode используются аналогично TRvNDRWriter и TRvRenderPreview.

GridHoriz и GridVert определяют горизонтальное и вертикальное расстояние, в дюймах или метрике, между каждой отметкой, рисуемой с помощью GridPen.

RulerType совместно с настройками, удобен для разработки точных отчетов, без необходимости производить тестовую печать.

MarginMethod и MarginPercent определяет и размер непечатных границ листа.

ShadowDepth определяет количество пикселей для тени листа.

Monochrome определяет, что вывод на должен быть монохромным или цветным битмапом. Сбрасывается при вызове NextPage или PrevPage.

ZoomInc определяет величину увеличения или уменьшения для ZoomIn и ZoomOut при изменении процента текущего zoom, ZoomFactor.

События TRvRenderPreview.

OnPageChange вызывается, когда сменяется текущая страница и позволяет программисту обновить пользовательский интерфейс для нового номера страницы.

OnZoomChange вызывается, когда изменяется текущий коэффициент масштабирования, ZoomFactor, что позволяет программисту обновить пользовательский интерфейс для нового коэффициента масштабирования.

Описание TRvRenderPrinter.

Компонент TRvRenderPrinter принимает файл созданный компонентом TRvNDRWriter и посылает его на текущий принтер. TRvRenderPrinter часто используется для печати из окна просмотра. TRvRenderPrinter это простой компонент, но и он имеет методы и свойства для управления печатью.

Свойства и события TRvRenderPrinter.

FileName это имя файла отчета созданного компонентом TRvNDRWriter, если StreamMode равен smMemory или smFile. Потоковый режим smUser используется, когда программист хочет предоставить свой собственный потоковый объект (любой наследник от TStream) , назначив свойство Stream компоненту TRvNDRWriter, TRvRenderPrinter и/или TRvRenderPreview. У компоненты TrvRenderPrinter отсутствую свои события. Для посылки отчета на принтер сделайте вызов Execute или ExecuteCustom.

Описание TRvRenderPDF.

Компонент TRvRenderPDF позволяет создавать документы PDF (Adobe Acrobat) прямо из отчета. Шрифты могут быть встроены в документ PDF, путем установки свойства EmbedFonts в TRUE. Качество рисунков, включенных в PDF файл можно установить через указание процента качества в свойстве ImageQuality. Сжатые PDF документы можно создать, если установить свойство UseCompression в TRUE, подключив ZLib в uses и определив событие OnCompress так:

Code: With TCompressionStream.Create(clMax, OutStream) do try. CopyFrom(InStream, InStream.Size); Finally. Free; End; { with }.

От переводчика.

Это вторая из двух книг посвященных генератору отчетов Rave Reports.

Главы «Лицензия на одного пользователя» и «Ограниченные гарантии» оставлены без перевода.

Поскольку у меня нет самого RAVE, то возможно местами качество перевода будет не совсем адекватное, поскольку невозможно проверить, что действительно кроется за тем или другим пунктом документации.

В документации очень много ошибок и несуразностей. Отсутствие некоторых глав как, например главы об очень важной части RAVE, об их технологии «mirroring» (зеркальное отражение частей отчета в другом месте без копирования), кстати, как и многое другое, включая отсутствующие отдельные куски текста, скопированные из других глав, но не измененные по контексту, разнобой в терминологии, многократное повторения вокруг темных мест, но не объяснения самой сути этого места и многое другое. И чем дальше к концу книги, тем хуже положение. Но это часто обычная ситуация разрабатывают прекрасный продукт, а документация страдает, но не до такой же степени.

Это не очень солидно для фирмы, видимо очень торопились или это был не очень ответственный работник, книга очень отличается по качеству от книги «Руководства разработчика», где такие ляпы практически отсутствуют. Так что если где-то, что-то вызывает недоумение, то знайте, что здесь не только переводчик виноват, но и авторы постарались. К сожалению, я не в состоянии изменить их ошибки, только местами.

По поводу замеченных недостатков и опечаток, просьба сообщать на e-mail anatoly@podgoretsky.com.

Начало работы - Техническая информация.

Лицензия на одного пользователя - Single User License Agreement.

This is a legal Agreement between you, as the end user, and Nevrona Designs. By opening the enclosed sealed disk package, or by using the disk, you are agreeing to be bound by the terms of this Agreement. If you do not agree with the terms of this Agreement, promptly return the unopened disk package and accompanying items, (including written materials), to the place you obtained them for a full refund.

1. Grant of License - Nevrona Designs grants to you the right to use one copy of the enclosed Nevrona Designs program, (the Software), on a single terminal connected to a single computer (i.e. CPU). You may make one copy of the Software for back-up purposes for use on your own computer. You must reproduce and include the copyright notice on the back-up copy. You may not network the Software or use it on more than a single computer or computer terminal at any time, unless a copy is purchased for each computer or terminal on the network that will use the Software. You may transfer this Software from one computer to another, provided that the Software is used on only one computer at a time. You may not rent or lease the Software, but you may transfer the Software and accompanying written material and this license to another person on a permanent basis provided you retain no copies and the other person agrees to accept the terms and conditions of this Agreement. THIS SOFTWARE MAY NOT BE DISTRIBUTED, IN MODIFIED OR UNMODIFIED FORM, AS PART OF ANY APPLICATION PROGRAM OR OTHER SOFTWARE THAT IS A LIBRARY-TYPE PRODUCT, DEVELOPMENT TOOL OR OPERATING SYSTEM, OR THAT MAY BE COMPETITIVE WITH, OR USED IN LIEU OF, THE PROGRAM PRODUCT, WITHOUT THE EXPRESS WRITTEN PERMISSION OF NEVRONA DESIGNS. This license does include the right to distribute applications using the enclosed software provided the above requirements are met.

2. Term - This Agreement is effective until you terminate it by destroying the Software, together with all copies. It will also terminate if you fail to follow this agreement. You agree upon termination to destroy the Software, together with all copies thereof.

3. Copyright - The software is owned by Nevrona Designs and is protected by United States laws and international treaty provisions. Therefore, you must treat the Software like any other copyrighted material (e.g. a book or musical recording) EXCEPT that you may either (a) make one copy of the Software solely for back-up or archival purposes, or (b) transfer the Software to a single hard disk provided you keep the original solely for back-up or archival purposes. You may not copy the written materials accompanying the Software.

Ограниченная гарантия - Limited Warranty.

1. Limited Warranty - Nevrona Designs warrants that the disks on which the Software is furnished to be free from defects in material and workmanship, under normal use, for a period of 90 days after the date of the original purchase. If, during this 90-day period, a defect in the disk should occur, the disk may be returned with proof of purchase to Nevrona Designs, which will replace the disk without charge. Nevrona Designs warrants that the Software will perform substantially in accordance with the accompanying written materials. Nevrona Designs does not warrant that the functions contained in the Software will meet your requirements, or any operation of the Software will be uninterrupted or error-free. However, Nevrona Designs will, after being notified of significant errors during the 90-day period, correct demonstrable and significant Software or documentation errors within a reasonable period of time, or refund all or a fair portion of the price you have paid for the Software at Nevrona Designs' option.

2. Disclaimer of Warranties - Nevrona Designs disclaims all other warranties, either expressed or implied, including but not limited to implied warranties of merchantability of fitness from particular purpose, with respect to the Software and accompanying written materials. This limited warranty gives you specific legal rights, you may have others, varying from state to state. Nevrona Designs will have no consequential damages. In no Событие, shall Nevrona Designs or its suppliers be liable for damages whatsoever, (including without limitation, damages for loss of business profits, business interruption, loss of business information, or any pecuniary loss), arising out of the use or the inability to this Nevrona Designs product, even if Nevrona Designs has been advised of the possibility of such damages. Some states do not allow the exclusion of limitation of liability for consequential or incidental damages, and this limitation may not apply to you.

3. Sole Remedy - Nevrona Designs' entire liability in your inclusive remedy shall be, at Nevrona Designs' option, either: (1) The return of the purchase price paid; or (2) Repair or replacement of the Software that does not meet Nevrona Designs' limited warranty, which is returned to Nevrona Designs with a copy of your receipt.

4. Governing Law - This Agreement will be consTRUEd and governed in accordance with laws of the State of Arizona.

5. U.S. Government Restricted Rights - This Software and documentation are provided with restrictive rights. Use, duplication or disclosure by the Government is subject to restrictions set forth in Section c(1)(ii) of the Rights and Technical Data in Computer Software clause at 52.227-7013.

Техническая поддержка.

Техническая поддержка, обновления и другая информация, относящаяся к Rave Reports, может быть получена на сайте Nevrona Designs. Для получения более подробной информации посетите один из слежующих сайтов:

Техническая поддержка - http:/www.nevrona.com/support.

Добавления, советы и другая информация - http:/www.nevrona.com/rave.

Обновления - http:/www.nevrona.com/rave/download.html.

Что такое RAVE?

Отчеты являются одним из наиболее сложных вещей, еще более сложной задачей, для некоторых являются базы данных. Отчеты предназначены для быстрого получения визуальной информации из данных. Для решения данной проблемы, на наиболее информационный манер, традиционные генераторы отчетов предлагают, секционное, в стиле таблиц представление данных. На сегодняшний день имеются более сложные требования к отчетам, которые не так легко решить стандартными секционно-табличными средствами.

Добро пожаловать в следующий уровень визуального проектирования отчетов! Визуальный Rave дизайнер предлагает многие уникальные свойства, которые помогут сделать процесс получения отчетов проще, быстрее и более понятным. Rave является интуитивной, визуальной средой разработки, которая может легко управлять широким спектром отчетов, много больше, чем чистый, рассчитанный на секции дизайнер. Rave также включает зеркальное отражение и другие технологии, для повторного использования содержимого ваших отчетов для быстрого внесения изменений и боле простого обслуживания. В действительности, Rave был специально разработан для получения гибкости и функциональности, в простом для освоения формате.

С чего начать? Поскольку, Rave является странично - ориентированным дизайнером, многие из его свойств должны быть понятны и легки для использования после небольшой практики. Есть большое количество параметров и других вещей, которые совсем понятны, при начальном освоении. Тем не менее, запомните, что многие из этих параметров могут быть просто проигнорированы в начале, но потом, они вам потребуются, после того как Вы приобретете более обширные знания. В действительности, помощники «Wizards» сгенерируют вам "стандартные" отчеты без знания, что происходит за сценой. Тем не менее, мы рекомендуем, что бы Вы потратили немного времени и быстро прочитали данное руководство.

В инсталляцию Rave включен проект, названный "RaveDemo", который содержит примеры различных отчетов. Что бы увидеть общий идеи, запустите RaveDemo.exe и откройте проект RaveDemo, для доступа к различным типам отчетов. Изучение проекта RaveDemo и других примеров является прекрасным методом изучения Rave.

Среда RAVE - Report Authoring Visual Environment.

Отчет может быть описан, как представление данных в визуальном виде, которое можно распечатать на бумаге или просматривать в электронном виде. Обычно, имеется набор таблиц, которые предоставляют данные для создания отчета. Например, представим себе: таблицу заказчиков «Customer», таблицу продукции «Products», и таблицу продаж «Items Sold». Данные таблицы должны быть скомбинированы для получения формы письма, счета и списка заказчиков.

Начнем с быстрого обзора Rave. Первый шаг используем Rave для запуска программы. Первая вещь, которую мы увидим, будет представление на экране страницы с закладками, с двумя окнами по обе стороны страницы и панели вверху экрана. На первый взгляд, слишком много элементов дизайнера Rave, для первого раза, что бы начать работать.

Начнем с того, что показывается при старте Rave. Для начала, поймите, что есть две группы панелей, отображаемых в дизайнере Rave; это компоненты и инструменты.

Компоненты, это такие элементы, которые "бросаются" или видны на странице редактора. Это могут быть секции, штрих коды, линии, графические примитивы, и другие. Пока не будем беспокоиться об этих вещах. Если объект виден на странице, то это компонент.

Панели, которые могут изменять компоненты, являются панелями инструментов. Есть несколько таких панелей: выравнивания, палитра цветов, редактор шрифтов и другие. Если на странице есть прямоугольник, который нужно закрасить цветом фона, сначала выберите данный прямоугольник, щелкнув на нем. Затем, используя панель цветов, смените цвет на требуемый. Панели можно скрывать и показывать, выбирая их из меню Tools. Для представления обзора в более простом виде, панели могут скрываться, до тех пор, пока они не понадобятся.

Заметим, что это был очень быстрый обзор. Имеется множество настроек и свойств, которые управляют поведением каждой части визуального дизайнера. Данное руководство состоит из двух частей, Описание системы Rave, включая компонент и инструмента, затем глава справочника, которая содержит подробное описание каждого свойства. Сначала, пройдите главы Описания, и только за тем переходите к главе справочника, для большего понимания различных свойств.

Первый взгляд.

Когда Rave первый раз запускается, то открывается окно, похожее на ниже представленную картинку. Поскольку Rave помнит, какой файл был открыт последний раз, ваше окно может немного отличаться. Но, области, показанные на данном рисунке, являются фундаментальными. Мы сначала расскажем о каждой части окна, что бы дать общее представление о дизайнере Rave.

Область навигации.

На самом верху визуального дизайнера Rave расположена область навигации. Сюда могут индивидуально прилепляться (docking) панели, и также могут присоединяться закладки. Присоединение панелей позволяет пользователю видеть все кнопки на панели и видеть больше панелей одновременно. Присоединение панелей позволяет иметь простой доступ до панелей, но только одна панель видна в тоже время.

Панели могут содержать одновременно и компоненты и инструменты. Инструмент это свойство, которое позволяет изменять объект на странице, как редактор шрифтов или палитра цветов. Компонент это объект, который размещается на странице как группа, линия, текст, регион или секция. Для поиска имени кнопки на панели, просто переместите мышь на кнопку, и появится всплывающая подсказка. Также, заметим, что при выборе кнопки она утапливается. Отжимается, когда кнопка нажимается.

Каждую панель можно спрятать. Что бы спрятать или показать панель, перейдите в меню Tool и выберите необходимую панель, из пункта Toolbars.

Страница (Основа Rave).

Стартовая точка визуального дизайнера Rave это страница. Страница это фундамент, на котором выполняются все действия по разработке. На странице показана сетка, которая выглядит примерно, как показано на рисунке. Внешний вид страницы можно изменить на свои собственные предпочтения, данный вопрос рассматривается в главе Предпочтения.

Одной из важных вещей, которую вы знаете и помните, это то, что страница имеет свойства, такие как высота и ширина. Для просмотра или изменения свойств страницы, перейдите в панель дерева проекта и разверните узел Report, нажатием на значок «+», затем выберите имя отчета (По умолчанию "Report1") и затем выберите строку, которая по умолчанию, называется "Page1". Щелкните один раз на имени страницы, оно будет подсвечено в дереве проектов. Подсветка означает, что страница выбрана, и ее свойства можно посмотреть в панели свойств.

Панель дерева проекта.

Панель дерева проекта это очень важная информативная часть дизайнера Rave и это также предоставляет простой путь для навигации по структуре проекта.

В данный момент мы рассмотрим только часть дерева проекта. Более подробно это будет рассмотрено в главе Дерево проекта.

Имеет три основных узла в дереве проекта: Report Library, Global Page Catalog и Data View Dictionary. Каждый из этих узлов (и их подузлов), может быть, развернут или свернут нажатием на символ плюс/минус. Подузлы могут создаваться и добавляться, выбором соответствующего пункта (New Report, New Global Page или New Data Object) в меню Project.

Узел Report Library содержит все отчеты в данном проекте. Каждый отчет может иметь от одной до нескольких страниц. Каждая из этих страниц может иметь один или несколько компонентов на ней.

Узел Global Page Catalog содержит все шаблоны отчета. Шаблоны отчетов могут содержать от одного до нескольких компонентов. Данные шаблоны могут затем повторно использоваться через уникальную технологию зеркального отражения Rave. Она позволяет включать такие элементы как заголовки и подвалы писем, готовые печатные формы, водяные знаки или определения полных страниц, которые затем могут служить основой для других отчетов.

Узел Data View Dictionary содержит все подключения данных, определенные для отчетов. Data view получает данные из приложения, через подсоединения данных, установленные для данного приложения.

Панель свойств.

Панель свойств помогает настраивать вид и поведение компонент. Когда компонент выбран на странице, Панель свойств отражает выбор показом различных свойств, ассоциированных с данным компонентом.

Изменение значений свойств делается очень просто, использованием различных ассоциированных выпадающих меню и окон редактирования. Если не выбран ни один компонент, то панель свойств появляется пустой.

Другой путь изменения свойств, это выбор значений из списка возможных значений. Например, свойство Color имеет кнопку со значком стрелка вниз. При нажатии на данную кнопку выпадает список цветов, из которого можно выбрать нужное значение. Некоторые свойства, у которых есть список выбора, могут быть выбраны двойным щелчком (вместо раскрытия списка и выбора из него значения), для доступа к одному следующему значению за раз.

Панели и окна инструментов.

Панели.

Панель это коллекция иконок, которые представляют их функции. Rave имеет несколько панелей, которые могут быть приклеены к любой стороне окна дизайнера, к закладкам, или быть спрятаны, пока не потребуются.

Для доступа к панелям, перейдите в меню Tools, и затем выберите Toolbars, выберите нужную панель. Выбор панели отмечается галочкой радом с панелью.

Панели разработаны так, что бы помнить свое последнее местонахождение. Когда панель скрывается, а затем снова показывается, то панель показывается в той же самой позиции экрана, в которой она была закрыта.

Перемещение панели.

Когда панель видима, она может находиться в одном из двух состояний: привязанная к закладке (tab-docked) или автономно (single docked). Привязанная панель индицируется только на закладке. Автономная панель имеет слева манипулятор ребро перемещения. Для смены состояния панели, сделайте щелчок правой кнопкой на одной из ее иконок. Появится маленькая кнопка с меткой "dock" или "undock". Щелкните по данной кнопке для смены состояния.

Когда панель отвязана, манипулятор панели "toolbar handle" это ребро с левой стороны, для перемещения панели. Для перемещения панели, поместите курсор на ребро "toolbar handle", нажмите левую кнопку мыши и, удерживая ее, переместите панель в новое положение в верхнем окне дизайнера. Лучший путь это потренироваться с этим.

Как замечено раньше, одиночные панели и панели на закладках могут быть размещены только в верхнем окне дизайнера. Пользователь может попрактиковаться с их перемещением.

Палитра панели.

Палитра панели имеет некоторое количество специальных свойств, которые будут рассмотрены более подробно. Область в верхнем правом углу дизайнера позволяет разместить одну или несколько панелей. Когда панели размещена, то закладка имеет имя панели. При размещении панелей в области закладок, создается новая закладка для отражения текущей панели.

Имеется инструмент (Tab Grabber), позволяющий перемещать закладки влево или вправо. Когда закладка перемещается слишком далеко вправо, появляются две стрелки позволяющие двигаться по закладкам. Вся область закладок может быть очищена перемещение всех закладок из этой области или закрытием панелей через меню. Область закладок также может быть перемещена на любой край окна (перемещая далеко вправо) освобождая верную область для дизайнера. Используйте Tab Grabber для перемещения области закладок (может быть легко заполнено или очищено) для перемещения далеко вправо.

Скрытие панелей.

Есть несколько путей для скрытия панелей. Скрытия панелей позволяет пользователю иметь 'чистый' Rave дизайнер. Это позволяет убрать неиспользованные или редко используемые панели, из среды дизайнера.

Для этого снимите отметку в меню Tools.

Панели компонент и утилит.

Есть два типа панелей: Компоненты (Component) и утилиты (Utility). Компонентные панели используются для помещения компонент, которые работают и имеют функции внутри отчета; смотри главу «Обзор компонент» для более подробной информации о компонентах. Большинство из компонент видимы, при размещении на странице, но есть несколько не видимых компонент, не видимы, означает, что данные компоненты появляются только в дереве проектов.

Панели утилит используются для установки свойств, которые влияют на вид компонент в отчете, например, панель цвета может изменять цвет текста в компоненте DataText.

Ниже список панелей, классифицированных по типам:

Панели компонент Панели утилит.

Standard Alignment.

Report Colors.

Bar Code Fills.

Drawing Fonts.

Lines.

Zoom.

Project.

Designer.

Окна инструментов.

Rave имеет два очень важных окна, которые обычно называются окна инструментов (Tool Windows). Так они называются, поскольку пользователь использует их как инструмент, для выполнения и навигации по отчету. Эти два окна – дерево проекта и панель свойств.

Данные окна обычно показываются после запуска Rave. но, если они не показаны, то перейдите в меню Tools и отметьте их.

Окно панели свойств.

Окно панели свойств дает информацию о характеристиках проект и компонент в проекте. Это полезно при разработке проекта, поскольку дает быстрый доступ к свойствам компонент и визуальный доступ для модификации свойств. Более подробная информация содержится в главе «Панель свойств».

Панель свойств отображает и позволяет изменять значение любых компонент помещенных на страницу, включая не видимые компоненты. Для получения информации о нужном компоненте, выберите данный компонент перед просмотром в панели свойств. Для более подробной информации о выборе объекта смотрите главу «Выбор компонент».

Дерево проекта.

Дерево проекта очень важная часть дизайнера Rave. Оно предоставляет простой путь для навигации по структуре отчета.

Дерево проекта состоит из трех главных узлов: Report Library, Global Page Catalog и Data View Dictionary. Для более подробной информации о функциональности этих компонент смотрите главу «Дерево проекта» и главу «Компоненты проекта».

Элементы внутри дерева проекта могут быть выбраны щелчком на элементе. Также помните, что компоненты в дереве проекта это также и компоненты на странице.

Примечание: невидимые компоненты в дереве проекта обычно зеленого цвета.

Подробности о навигации по дереву проекта, содержатся в соответствующей главе, сейчас дано только общий обзор.

Обзор компонент.

Что такое компонент.

Компонентом называется то что, размещается на странице, такое как - штрих код, линия, регион, графический примитив (shape) и другие. Компоненты, доступные Rave, находятся на панелях (например, Standard, Drawing, Report и Barcode).

Панели доступны, через выбор меню Tools | Toolbars. Доступные панели показываются в следующем подменю и имеют отметку, если они видимы в текущий момент. После того как панель становится активной, компонент может быть выбран и помещен на страницу. Страница это особый компонент, и более детально рассмотрен в главе «Дизайнер страниц». с каждым компонентом ассоциируется набор свойств. Эти свойства могут быть просмотрены с помощью панели свойств. Установка свойств каждого компонента производится или вводом значения в текстовом диалоге, использование выпадающего меню или нажатием на кнопку с символом эллипса (…).

Есть много свойств ассоциированных с каждым компонентом, но не беспокойтесь об их количестве. Свойства позволяют настраивать поведение компонента и в большинстве случаев значение по умолчанию вполне адекватно. Также, заметьте, что количество свойств может варьироваться в зависимости от уровня пользователя, можно изменить через предпочтения (preferences). Для настройки уровня пользователя откройте закладку environment в диалоге preferences. Смотрите главу «Предпочтения».

Поскольку есть много свойств, ассоциированных с каждым компонентом, данная глава делает фокус в основном на панелях компонент, чем на их свойства. Текущая глава производит хороший обзор каждой панели компонент без детального рассмотрения свойств. Заметим, что многие компоненты имеют общии свойства, так что как только свойство изучено, то оно может быть применено к остальным компонентам.

Компоненты также определяются отношениями к другим компонентам. Данная связь определяется как родитель-дитя. Когда текстовый компонент помещается на страницу, родителем является страница и подчиненным текстовый компонент. По-другому на это можно посмотреть так, что страница содержит текстовый компонент, родительский компонент содержит подчиненный компонент.

Связь родитель-дитя также расширяется на позиционирование компонентов. Любое позиционирование делается относительно верхнего левого угла родителя, это свойства Left и Top, которые используются для определения относительной позиции компонента. Родитель подобен компоненту Section, который может содержать любое количество других компонент; затем если родительский компонент перемещается, его подчиненные компоненты перемещаются одновременно. Если родительский компонент удаляется, то удаляются и все его дети.

Связь родитель-дитя определяется при создании подчиненного компонента. Если подчиненный компонент бросается на родительский компонент, то он становится дитем данного родителя. Если компонент бросаются на страницу, и затем перемещается на другой компонент (такой как Section), то он все равно остается дитем страницы.

Дерево проекта, более подробно описано позже, визуально показывает связь родитель-дитя компонент. В действительности, компонент Project является главным родителем всех отчетов, остальных страниц и объектов данных. Отчеты родители страниц отчета. Страницы родители компонент помещенных на них. Еще есть другие компоненты, которые могут быть родителями, такие как Region (регионы), Band (полосы) и Section (секции).

Панели компонент.

Есть четыре стандартные панели компонент. Другие панели компонент могут быть представлены дополнительными add-on пакетами. Нормальный набор компонент следующий: "Standard", "Drawing", "Report" и "Bar Code". Одно из общих свойств, применимое ко всем компонентам, будет объяснено здесь.

Свойство Name используется для задания имени, которое должно быть уникальным. По умолчанию Rave назначает последовательные имена, базируясь на типе компонента, такие как 'Section1', 'Section2' и так далее. Смените его на более описательное, что бы сделать дерево проекта более читабельным и проект более простым для обслуживания. Свойство Name не должно содержать пробелов или специальных символов. Данное имя будет использоваться в панели дерева проектов.

Несколько следующих глав дают обзор четырех панелей компонент. Это служит только как введение, более подробная информация будет сделано позже.

Стандартные компоненты.

Панель стандартных компонент, содержит большинство, наиболее часто используемых компонент. Когда панель стандартных компонент видима, выберите и поместите компонент, такой как битмап, секция, текстовый компонент на страницу.

Компонент Text создает одиночную строку текста, которая может быть изменена с помощью панели свойств.

Компонент Memo позволяет отображать несколько строк текста, включая многострочный текст.

Компонент Section это очень специальный компонент, который позволяет объединять несколько компонент.

Компоненты Bitmap и Metafile, позволяют разместить графические образы в отчете. Компонент FontMaster позволяет пользователю определять стандартные шрифты для различных частей отчета, например заголовкам, содержимому и подвалам.

Последний компонент называется PageNumInit, данный компонент позволяет начать нумерацию в отчете.

Используйте эти компоненты для создания базы отчета, вставки текста и образов.

Компоненты штрих кодов.

Панель штрих кодов компонент содержит шесть компонент: PostNetBarCode, 2of5BarCode, Code39BarCode, 128BarCode, UPCBarCode и EANBarCode.

Они используются для создания всех типов штрих кодов в отчете.

Компоненты рисования.

Панель компонентов рисования содержат графические компонент. Это включает рисование линий, квадратов, прямоугольников, кругов и эллипсов.

Компоненты слева направо: Line, HLine, VLine, Rectangle, Square, Ellipse и Circle.

Они используются для рисования графических примитивов и общего форматирования отчета. Используйте их для разделения областей отчета или для создания информативных образов.

Компоненты отчета.

Здесь несколько компонент отчета: (слева направо) DataText, DataMemo, CalcText, DataMirrorSection, Region, Band, DataBand, DataCycle, CalcOp, CalcTotal, CalcController. Используйте компонент для взаимодействия с базой и создания функциональных отчетов.

Компоненты с красной точкой в верхнем правом углу, относятся к компонентам данных (Data Aware) и могут отображать информацию из базы данных. Каждый компонент имеет свойство DataView, которое позволяет взаимодействовать с базой данных.

Компоненты зеленым фоном не видимые. Их можно увидеть только в дереве проекта, а не на странице.

Компоненты Band и DataBand должны быть размещены внутри региона (Region). Поэтому при размещении их на странице, сначала поместите Region на страницу, в котором затем разместите Band или DataBand компонент. Нет ограничения на количество компонент Bands в регионе, или обязанности все размещать в одном регионе. Может быть столько регионов, сколько вам нужно. Каждый компонент Band имеет свой собственных набор свойств для управления его поведением. Смотрите главу «Компоненты отчета» для получения более подробной информации..

Дизайнер страниц.

Обзор.

Знание компонент и инструмента не достаточно для эффективной работы с Rave. Вы также должны знать об наиболее фундаментальном компоненте Rave, о компоненте Page (страница). В данной главе в деталях объяснен компонент Page и его связи с деревом проекта и панелью свойств. Поскольку дерево проектов и панель свойств имеют свои собственные главы, в которых они рассмотрены индивидуально, данная глава рассматривает их связи с Page. Также в данной главе приведены основы перемещений объектов на странице.

Базовый компонент Page и его панели.

Базовым компонентом в визуальном дизайнере Rave является компонент Page. Компонент Page не является нормальным компонентом, и его нет в панели компонент, но он имеет свои собственные свойства, что позволяет думать о нем, как о базовом компоненте, являющим контейнером для построения отчета. Все компоненты Rave должны быть размещены на Page. Page предоставляет сетку на пали страницы. Внешний вид страницы управляется предпочтениями, которые описаны в главе «Предпочтения». Изменение внешнего вида рассматривается в главе «Панели утилит».

Подобно всем компонентам, компонент Page также имеет свойства, такие как Height, Width, Description и Name. Для просмотра или изменения свойств Page, перейдите в панель дерева проекта и раскройте узел Report, нажав на символ "+", затем щелкните на имени отчета (По умолчанию "Report1"). Щелчок на имени отчета покажет вам "Page1", которое является именем по умолчанию для Page. Щелкните один раз на нем и заметьте, что элемент "Page1" подсветился. Это означает, что страница выбрана, и теперь можно посмотреть ее свойства в панели свойств.

Свойства страницы позволяют отчету быть более информативным. Например, вместо Page1, Page2, Page3, это могут быть имена Invoice, PO, PackingSlip. Что бы сделать это, используйте свойство Name в панели свойств. Имя может быть любым, которое пожелает пользователь, но оно не может иметь пробелов или специальных символов. Помните, что Name только для дизайнера Rave и видимо только в дереве проектов и в закладках на панели Page.

Образ дерева проектов и панели свойств, изменяется после переименования Page. Теперь дерево проекта выглядит более информативно. Это полезно при настройке многих свойств ассоциированных со страницей, что делает более информативным и удобным при дельнейшем использовании и изменении.

Выбор компонент.

Для выбора компонент просто щелкните на них. Переместите указатель мыши, на область компонента, и однократно щелкните на нем левой кнопкой мыши. Выбранный компонент будет обведен специальной рамочкой с маркерами.

Маркеры могут быть четырех различных цветов: зеленый, серый, красный и желтый. Зеленый маркер указывает, что текущий компонент выбран только один компонент. Серый маркер, что имеется более одного выбранного компонента, красный маркер индицирует, что текущий компонент зафиксирован. Желтый маркер индицирует, что объекты зеркально отражены и не могут быть изменены.

Выбор более одного компонента за раз делается аналогичным образом, за исключением, что требуется удерживать клавишу Shift при выборе объектов.

Другим методом выбора более одного компонента за раз, это нарисовать виртуальную рамку вокруг них. Для этого поместите курсор мыши в нужную позицию и перемещайте курсор мыши, не отпуская левой кнопки.

Для снятия выбора, просто щелкните на закладке дизайнера страницы или выберите другой компонент.

Когда выбрано несколько компонент, только общие свойства показываются в панели свойств. При смене свойства, изменение применяется ко всем выбранным компонентам.

Имеется специальное свойство для всех компонент, называемое Locked (заблокировано). Если свойство Locked установлено в True, то компонент может быть выбран, но его свойства нельзя изменить (конечно, за исключением свойства Locked). Если выбранные компоненты зафиксированы, то маркеры и имена свойств, для данных компонент будут красного цвета (как отмечено ранее). Если компонент имеет подчиненные компоненты (детей), то родитель управляет доступом. Свойство Locked имеет выпадающее меню, или True/False, указывая состояние блокировки, или оно указывает имя компонента, который управляет его состоянием. Дальнейшее обсуждение считает, что компоненты не заблокированы.

Перемещение и изменение размеров компонент.

Для перемещения компонента, просто выберите его и, не отпуская левой клавиши мыши, переместите его нужную позицию. При выборе более одного компонента, все они перемещаются одновременно. Заметим, что это не касается заблокированных компонент.

Основное назначение маркеров это изменение размеров компонент. Изменение работает только для одного компонента за раз, то есть группа выбранных компонент не может быть изменена одновременно. Компоненты могут быть изменены по вертикали, горизонтали или по диагонали. При изменении по диагонали, компонент меняет оба своих размера. Просто нажмите на нужный маркер и, не отпуская клавиши мыши, перетащите маркер в нужную позицию. Заблокированные компоненты не могут быть изменены.

Копирование и вставка.

Копирование и вставка выполняются аналогично, как в стандартных Windows приложениях. После выбора компонента (или группы компонент), выберите Cut или Copy из меню Edit, или используйте комбинацию клавиш Ctrl-X или Ctrl-C, или правый щелчок мыши на компоненте и выбор Cut или Copy из контекстного меню.

Для вставки компонент выберите одним из предыдущих методов (меню Edit, Ctrl-V или контекстного меню).

Снова, важный пункт заблокированные компоненты не могут быть вырезаны, поскольку это убирает объект из позиции.

Упражнение 1: выбор, изменение размеров и перемещение компонент.

Для выбора объекта:

1. щелкнете на компоненте. Рамка и маркеры вокруг него;

2. или выберите компонент из дерева проекта.

Для изменения размера:

1. выберите компонент;

2. переместите курсор, пока его вид не изменится на двунаправленные стрелки;

3. удерживая маркер, установите необходимый размер.

Для перемещения компонента:

1. выберите компонент;

2. перемещайте курсор поверх компонента (не на маркер, как это было при изменении размера компонента). Щелкните мышкой на компоненте и удерживая ее;

3. перемещайте компонент мышкой;

4. переместите в нужную позицию.

5. освободите курсор.

Упражнение 2: вырезание и вставка.

С помощью меню Edit:

1. выберите компонент;

2. выберите пункт Cut из меню Edit. Этим Вы поместите компонент в буфер обмена, и компонент при этом исчезнет со страницы;

3. выберите пункт Paste из меню Edit.

С использование горячих клавиш:

1. выберите компонент;

2. нажмите Ctrl+X. Этим Вы поместите компонент в буфер обмена, и компонент при этом исчезнет со страницы;

3. нажмите Ctrl+V.

С помощью контекстного меню:

1. выберите компонент;

2. нажмите правую кнопку мыши на компоненте, в контекстном меню выберите пункт Cut. Этим Вы поместите компонент в буфер обмена, и компонент при этом исчезнет со страницы;

3. вставьте выше указанным методом.

Дерево проекта.

Панель дерева проектов предоставляет простой путь для навигации по структуре проекта. Данный вид дает обзор структуры страниц и структуры в свободном стиле. Поэтому, это делает дерево проекта очень информативной частью дизайнера Rave. Независимо делаете ли Вы простые и сложные отчеты, помните про эту панель, и увидите насколько информативным это может быть.

Проект может содержать множество определений в каждой категории: Report Library (библиотека отчетов), Global Page Catalog (каталог глобальных страниц) и Data View Dictionary (словарь данных). Каждый узел (и любые под узлы) могут быть свернуты или развернуты, нажатием на символ плюс/минус. Любые из этих узлов могут быть добавлены из меню Project. Там Вы увидите пункты для каждого из узлов New Report (новый отчет), New Global Page (новая глобальная страница) и New Data View (новый просмотр данных). До добавления новой страницы New Page в отчет, узел Report Library, предварительно выберите нужный отчет и используйте пункт New Page из меню Project.

Развертывание дерева и контекстное меню.

Более простым путем выполнения действий над элементами дерева проекта, это использование контекстного меню. Доступно много разных контекстных меню. Выбор контекстного меню на главном узле, типа Report Library вызывает контекстное меню с двумя пунктами Expand All и Collapse All. Данные два пункта предназначены для свертывания или развертывания всех узлов дерева, что предоставляет быстрый путь для доступа ко всем элементам.

Выбор пол-узла, типа Page, вызывает пункты удаления страницы. Может быть меньше или больше доступных функций.

Выбор компонента может показать контекстное меню с множеством пунктов. Те же пункты появляются и при вызове контекстного меню на компоненте в дизайнере страниц. Также, эти пункты отображаются в панели утилит. Может быть меньше или больше доступных функций. Для ускорения создания отчета или навигации по нему быстрой простой требуется разбираться в данных функциях этих контекстных меню.

Связи родитель-ребенок.

До этого Вы узнали, как перемещаться по дереву, теперь же мы проведем маленький ликбез, что такое дерево.

Дерево проекта показывается, как дерево растущее вниз. База или корень (root) дерева находится на верху списка. Каждое последовательное вхождение является ребенком корня или веткой дерева. Это делает корень родителем всех его детей. Каждая ветвь также сама по себе является корнем для своих детей.

Техника, использованная в предыдущей главе, показывается, как двигаться по дереву, развертывая узлы, ассоциированные с каждым родителем. Когда ветвь имеет детей, узел появляется слева от имени ветви.

Библиотека отчетов является корнем дерева и имеет одного ребенка, называемого Report1, показанного с подсветкой текста.

Report1 имеет следующих детей: Page1, Page2, Page3, Page4, Page5 и Page6.

Page1 имеет следующих детей: Text1, Text2 и Memo1.

Здесь есть две группы братьев и сестер. Как и реальной семье с родителями и детьми, дети могут иметь братьев и сестер. Первая группа братьев и сестер: Page1, Page2, Page3, Page4, Page5 и Page6.

Первая группа братьев и сестер: Text1, Text2 и Memo1. Могут быть и другие семейные взаимосвязи, но главная, как уже отмечено, это связь родитель-ребенок.

Библиотека отчетов.

Узел Report Library (библиотека отчетов) отображает структуру дизайна, включающую все использованные компоненты в каждом из отчетов. Обычно, компонент выбирается на панели страницы, просто отмечая его мышью. Тем не менее, библиотека отчетов также. Первая группа братьев и сестер использована для выбора компонентов, щелчком по имени. Когда мы щелкаем по имени компонентов, то оно подсвечивается. Для выбора нескольких компонентов, придерживайте клавишу Shift, при выборе.

Проект может быть простым, состоящим из одного или двух определений, но может быть и сложным с множеством определений. Каждый отчет, который создается, должен иметь свою собственную структуру. Для выбора и переключения на различные отчеты, просто делайте двойной щелчок на имени отчета в структуре библиотеки отчетов.

СОВЕТ: Чтобы сделать навигацию и отчет, простым для понимания, используйте описательное свойство Name. Смотрите упражнение 4 «именование компонент» в конце данной главы для эффективного использования, данного свойства.

Каталог глобальных страниц.

Узел каталог глобальных страниц, где содержатся определения, которые используются как шаблон, которые могут отражаться. Это включает такие вещи как заголовки писем, формы, водяные знаки и другие определения страниц, которые могут использоваться в различных отчетах. Это упрощает общую разработку. Примером может быть отображение секции компонент на глобальной странице, где одинаковое содержимое может быть отпечатано (например, счет), но также может иметь различные заголовки в подвале страниц, например "Original", "File Copy" и "Shipping".

Загрузка и выгрузка глобальных страниц.

Глобальные страницы очень полезны и применимы для дизайна, особенно когда они могут быть быстро доступны. Эти страницы могут содержать все типы объектов и компонент, которые могут повторяться и отражаться через множество страниц в различных отчетах. Многие отчеты в библиотеки отчетов могут использовать любую из глобальных страниц каталога.

При создании отчетов, полезным свойством дизайнера Rave является закладки дизайнера страниц. Они расположены вверху окна дизайнера страниц. Здесь все закладки, используемых страниц.

Глобальные страницы можно добавить на закладку для более быстрого доступа, что означает, что разработчику не нужно прокручивать все дерево для поиска нужной, часто используемой страницы. Вместо этого разработчик может просто загрузить страницу в закладки дизайнера и затем просто выбирать нужную страницу. Глобальные страницы могут быть загружены или выгружены закладок дизайнера, просто по правому щелчку мыши на глобальной странице и использованием контекстного меню для выбора. Быстрый путь выгрузить глобальную страницу это выбрать ее в области закладок, зто щелкнуть по странице и нажать клавишу Ctrl+F4.

Словарь данных.

Словарь данных в дизайнере Rave это узел где указаны все подключения данных для отчетов. Для добавления просмотра данных в данный список, выберите New Data View из меню Project. Это вызовет диалог Data Connections. Данное окно покажет все подключения данных Rave, которые сейчас активны. Затем выберите любое из них для создания нового просмотра подсоединенного к данному подключению.

Ctrl+Drag&Drop.

Ctrl+Drag&Drop используется для создания или зеркального отражения элемента из структуры дерева проекта или другого узла в данной структуре отчета или текущей страницы дизайнера. При перетаскивании из панели дерева проекта на страницу дизайнера, место бросания определяется местом, в котором отпущена мышь. Но, при перетаскивании их одного узла страницы в другой (в панели дерева проекта), по умолчанию, место остается тем же, что и в источнике.

ПРИМЕЧАНИЕ:

При перетаскивании не видимого компонента, он должен быть отражаемого типа. Копирование для не отражаемых типов не работает. Компоненты Regions и Bands, для которых не разрешено зеркальное отражение. Для зеркального отражения региона, сделайте регион частью секции и затем отразите эту секцию. Секция также может включать и другие компоненты.

ПРЕДУПРЕЖДЕНИЕ:

Перетаскивание (Drag&Drop) работает из страницы отчета в страницу отчета, глобальной страницы в глобальную страницу, глобальную страницу в страницу отчета, но это не работает перетаскивания из страницы отчета в глобальную страницу, поскольку компоненты на отчете не видимы другим отчетам и поэтому не могут отражаться в глобальной странице.

Alt+Drag.

Alt+Drag используется для смены родителя компонента в новый контейнер подобный секции. Все перемещения для данного компонента должны быть сделаны в той же самой странице. Когда создается новая секция, пользователь может выбрать все элементы из другой секции для помещения в новую секцию. В этом случае родитель должен быть сменен из старой секции на новую секцию, и затем новая секция может быть зеркально отражена.

ПРИМЕЧАНИЕ:

Компонент назначения должен быть контейнерного типа. Page, Region и Section все являются хранителями или контейнерами. Так, если есть или более секций на странице, элементы могут быть перетащены в другую секцию. Также все компоненты могут быть перетащены со страницы на одну из секций.

Упражнение 3: навигация по дереву проектов.

Поскольку многие проекты отчета очень сложные, иерархическое дерево проекта помогает двигаться по отчетам.

Навигации по иерархии (развертывание, свертывание и выбор):

1. разверните элемент путем нажатия на символ плюс. Затем оно сменится на минус и развернет элемент с под элементами, такими как Report1, Page1 и остальными.

2. свертывание элемента осуществляется нажатием на символ минус, он сменит свое рисунок на символ плюс и свернет все под элементы.

3. выбор элемента из дерева проекта выполняется нажатием мышкой на нужный элемент. Выбранный элемент подсвечивается.

Упражнение 4: именование компонент.

1. Поскольку проекты обычно очень сложные, строго рекомендуется давать им значимые имена.

2. По умолчанию, свойство Name получает имя подобное "Report1", "Report2" и так далее. Но гораздо легче управлять проектом, если отчеты имеют более полезные имена. Это можно сделать через свойство Name.

3. при разработке соглашений об именах будьте созидательны, но помните, что пробелы или специальные символы не разрешены в свойстве Name.

4. в примере панели дерева проектов, по умолчанию имена отчетов были изменены. Вместо "Report1" до "Report7", имена отчетов были названы: "CustomerList", "CustomerLabels", "CustomerDue", "Invoice", "PO", "ProductsOnHand" и "ProductsOnOrder". Это важно для понимания, что панель дерева проектов в этом делает проект проще. Но, без информативной системы имен, панель дерева проектов не показывает свой потенциал.

Переименование отчета (или других компонент):

1. выберите отчет (компонент);

2. убедитесь что отчет, который переименовывается выбран. Должен быть подсвечен;

3. перейдите в панель свойств и найдите свойство Name;

4. в поле Name, введите нудное имя;

5. нажмите Enter, после ввода нового имени;

6. посмотрите в дереве проекта и убедитесь, что имя отчета (компонента) изменилось.

7.

Упражнение 5: загрузка и выгрузка глобальных страниц.

Загрузка и выгрузка глобальных страниц в область закладок дизайнера страниц делает доступ к этим страницам более быстрым и удобным. Это особенно истинно, когда Вы работаете с отображенными секциями и объектами из разных отчетов.

Загрузка глобальной страницы:

1. запустите новый отчет;

2. вставьте четыре пустых отчета, выбрав New Report из меню Project или щелчком New Report в панели Project;

3. затем, выберите "Page1" в первом отчете. Сделайте это с помощью дерева проекта. Отметьте "Page1" в дереве или щелкните на закладке "Page 1" в закладке дизайнера страниц. Как только страница будет выбрана, ее имя будет подсвечено;

4. добавьте три глобальные страницы в отчет. Сделайте это выбором New Global Page из меню Project или щелчком New Global Page в закладке дизайнера страниц;

5. заметьте, поскольку первая страница в первом отчете была выбрана при добавлении глобальной страницы в закладке дизайнера страниц. То страницы были добавлены в дерево проектов в каталог глобальных страниц;

6. щелкните на другой странице отчета. Заметьте, что поскольку была выбрана другая страница в области 7 закладок дизайнера страниц. Для добавления глобальных страниц в область закладок дизайнера страниц сделайте вызов контекстного меню глобальной страницы дерева проекта и выберите Load Page. Попробуйте загрузить все три глобальные страницы;

7. как только глобальные страницы загрузятся, то они будут видны в области закладок дизайнера страниц;

8. попробуйте загрузить глобальные страницы к двум другим оставшимся отчетам.

Выгрузка глобальной страницы:

1. закончите шаги из предыдущего упражнения;

2. выберите страницу из Report 3, которая содержит все загруженные страницы;

3. есть два пути выгрузки страницы. Один путь это использовать контекстное меню, а другой путь это использовать горячие клавиши;

4. первый путь использовать контекстное меню, что требует, во-первых, выбрать страницу для выгрузки;

5. затем, вызвать контекстное меню на глобальной странице и выбрать пункт Unload Page из меню. Повторите его три раза для отчета Report 3;

6. теперь мы попробуем использовать второй путь;

7. выберите следующую страницу в Report 4. Убедитесь, что она содержит все глобальные страниц в области закладок дизайнера страниц;

8. так как страница в Report 4 выбрана, Вы можете видеть три глобальные страницы в области закладок дизайнера страниц, выберите одну из глобальных страниц из области закладок дизайнера страниц;

9. теперь нажмите Ctrl+F4 для выгрузки страницы;

10. повторите это для оставшихся глобальных страниц в каталоге.

11.

Упражнение 6: перетаскивание компонент (Ctrl+Drag).

Одной из обычных задач по перетаскиванию бывает копирование компонента Data Field на страницу в визуальном дизайнере. Приемник должен быть существующим компонентом DataBand или чистой областью страницы. Компонент Data Field будет преобразован в DataText или DataMemo на области назначения, в зависимости от типа поля источника. Выполним это с помощью следующих шагов.

Перетаскивание:

1. перейдем на узел Data View Dictionary, развернем его, если свернут;

2. выберем один из Data Views и развернем его, если свернут;

3. выберем компонент поля для копирования;

4. нажмем и удерживаем клавишу, теперь тащим это поле на страницу;

5. отпускаем клавишу мыши и клавишу Ctrl;

6. выбираем только что скопированное поле и устанавливаем его свойства.

Данное упражнение может быть слишком простое, но дадим здесь пользователю шаги необходимые для выполнения перетягивания компонента. Поскольку полный отчет еще не закончен, так что не беспокоимся о его работоспособности.

Упражнение 7: смена родителя компонента (Alt+Drag).

Смена родителя компонента может быть очень полезной, для создания его компонент. Например, скажем, есть страница, содержащая компоненты, которые было бы лучше сгруппировать с секцию. Текущее состояние в том, страница является родителем компонент, которые надо сгруппировать. Для группы элементов, родитель должен быть сменен на компонент секции. После того как это будет сделано, элементы окажутся в секции, которую можно будет потом перемещать межу подобными другими. Есть и обратный смысл, может потребоваться убрать компонент обратно из секции и просто переместить на страницу, просто используйте Alt+Drag для выполнения данной задачи.

Смена родителя компонента:

1. перейдите Report Library, развернем его, если свернут;

2. развернем узел Report, который содержит страницу с определением;

3. развернем узел Report, который содержит приемник и источник, что бы они были видны. В Customer Statement, есть секция на странице. Мы сменим родителя у PageNumInit и Memo1 со страницы на секцию;

4. выделим компоненты, у которых мы желаем сменить родителя. Для выделения удерживаем клавишу Shift при выборе компонент. Когда закончим выбор отпустим клавишу Shift. Выбранные компоненты должны быть подсвечены;

5. нажимаем и удерживаем клавишу Alt, теперь перетаскиваем на новый родительский компонент. В данном примере, клавиша Alt удерживается при выборе и перетягивании на новый компонент. При перетягивании компонент на нового родителя, видим, что курсор изменяется при попадании не приемник. Когда курсор показывает, что он находится над приемником, освобождаем клавишу мыши и затем клавишу Alt;

6. заметим, что компоненты теперь имеют нового родителя, и у родителя появился маркер минус, указывая, сто у родителя есть несколько компонент;

7. после окончания перемещения новых компонент, они могут быть настроены, как требуется.

Панель свойств.

Что такое панель.

Панель свойств дает информацию о компонентах проекта. Это наиболее полезно при разработке отчета, поскольку дает простой доступ до всех ассоциированных с каждым компонентом свойств.

Панель свойств показывает и позволяет изменять значения любого компонента помещенного на страницу. Для получения информации о конкретном компоненте, выберите компонент перед просмотром его в панели свойств (смотрите главу «Выбор компонент» для получения более подробной информации по выбору объектов).

Панель свойств показывает текущие свойства компонента. Например, выбрав компонент DataText, в панели свойств будут показаны все его свойства, которые доступны для данного компонента.

В панели свойств есть три области. Первая в самом верху, показывает имя и тип компонента. Вторая в середине, показывает все свойства в двух колонках. Левая колонка содержит имена свойств, а правая показывает текущее значение этих свойств. Внизу панели свойств находится третья область, в которой содержится краткое описание текущего выбранного свойства.

В списке свойств (средняя секция), линия, разделяющая две колонки, может быть перемещена, позволяя лучший просмотр имен и значений. Для выполнения данной операции, поместите курсор поверх линии, пока его форма не сменится на двунаправленные стрелки. Затем нажмите левую кнопку мыши и, удерживая ее, перетяните ее влево или вправо для изменения колонок.

Помните, что компонент должен быть выбран, что бы его свойства можно было увидеть. Это также доступно и для нескольких компонент одновременно. Как только компонент выбран, любые его свойства в панели могут быть выбраны щелчком на нужном имени или его ячейке значения. У выбранного свойства затем можно изменить его значение. Когда выбрано любое свойство в панели свойств, то можно перемещаться между свойствами и с помощью клавиш вверх/вниз.

Некоторые из имен свойств показаны жирным шрифтом. Это означает, что текущее значение отличается от значения по умолчанию. Например, когда компонент DataText размещается на странице, цвет по умолчанию черный. При смене цвета с красного на черный, имя свойства становится жирным. Когда значение снова меняется на значение по умолчанию, шрифт снова становится нормальным.

Как это можно использовать? Представим на момент, что отчет был разработанный коллегой, имеет проблему и не работает. Быстрый взгляд на свойства, позволяет найти измененные, возврат которых в исходное состояние позволяет решить проблему.

В то время как большинство компонент может быть выбрано щелчком по компоненту, то компонент Page особый случай. Щелчок по панели в окне визуального дизайнера очищает панель свойств, но не выбирает саму страницу.

Для выбора свойств страницы, щелкните по закладке вверху окна (область называемая, область закладок страниц) где показывается номер страницы. Другой альтернативой является выбор в дереве проекта.

Типы свойств.

Каждое свойство имеет ассоциированный тип. Эти свойства можно редактировать в панели свойств. Свойства могут быть строковые или цифровые.

При редактировании строковых свойств Вы можете вводить любые символы, которые могут отображаться на экране. При редактировании числовых значений, это должно быть допустимое числовое значение. Десятичные числа другое общее свойство, которое можно редактировать.

Многие свойства имеют предопределенные значения, которые можно выбрать. Данные значения показываются в виде списка, из которого их можно выбрать. Также есть свойства, которые сами являются другими свойствами, ассоциированными с ними.

Редакторы.

В зависимости от типа выбранного свойства, есть три типа полей ввода. Первый тип это простое поле ввода, в котором печатается значение. Значение может быть цифровым, символьным, алфавитно-цифровым или набором одного из возможных значений. Выпадающий список это второй тип ввода, который может использовать пользователь. Если значение свойства является одним из предопределенных значений, выпадающий список появляется при нажатии на кнопку с маленькой стрелкой в правом углу поля ввода. Выберите нужное значение путем клика на нем. Третьим типом является диалог. Некоторые свойства требуют более одного значения для установки свойства (такие как шрифты). Для установки таких свойств есть кнопка с тремя точками (называемая эллипс) в правом углу поля ввода. При нажатии на данную кнопку появляется диалог (или мастер (wizard)) и в данном диалоге можно установить множество свойств.

Контекстное меню.

При нажатии на правую кнопку появляется всплывающее контекстное меню. Данное контекстное меню можно использовать для установки различных параметров панели свойств.

Свойство Hints, первый элемент меню, прячет или показывает окно подсказок, которое расположено в самом низу панели свойств. Подсветка изменений второй элемент меню, разрешая или запрещая показ измененных свойств жирным шрифтом. Exclude Name, Size и Pos Changes это третий пункт меню определяющий, что изменение имени, размера и позиции (ширина и высота) исключаются из подсветки жирным при изменении их значений по умолчанию. Третий пункт становится полезным при множественном изменении свойств, и нужно видеть только те свойства, которые обычно не изменяются.

Упражнение 8: навигация по панели.

Открытие панели свойств.

1. если панель свойств не видима, то перейдите в меню Tools. Из Tools подменю, выберите Property Panel. Поставьте там отметку.

Определение областей панели свойств.

2. в данном примере, используется базовый компонент Page. Поэтому выберите компонент Page, щелкнув на страницу в области закладок дизайнера страниц. Заметим, что после выбора страницы, ее свойства появятся в панели свойств.

3. Дальше сделайте окно подсказки видимым внизу панели свойств, если оно не видимо в данный момент. В контекстном меню отметьте все доступные параметры.

4. расширьте панель свойств, что бы Вы могли видеть все свойства и также окно подсказок. В шагах от 5 до 8, читайте подсказки для получения большей информации о каждом свойстве. Примечание: образ справа изменяется в течение нескольких примеров.

5. выберите свойство Name. Заметим, что данное имя отражается в заголовке панели "Page1: Page component". Другая половина данной строки указывает на компонент, к которому это относится. Компонент является компонентом Page, что и отражается здесь. Свойство Name из примера строкового типа.

6. выберите свойство Bin строкой ниже. Заметим, что это показывается как выпадающее меню. Выпадающее меню выдает несколько предопределенных параметров, из которых можно сделать выбор.

7. выберите поле Grid Spacing. В данном примере это цифровой тип свойства. Что бы увидеть, что данное свойство делает, просто измените значение, и посмотрите на страницу.

8. нажмите на кнопку эллипс (…) в свойстве Parameters и появится диалог. Диалог позволяет устанавливать свойству множество значений.

9. в шаге 3, параметр Highlight Changes был отмечен в контекстном меню. Перейдите к свойству PaperSize и выберите другой тип бумаги. Заметим, что не только значение изменилось, но и свойство стало жирным. Данное подсвечивание жирным становится полезным для определения измененных свойств по умолчанию или их начальных значений. Попробуйте изменить другие значения, такие как высота и ширина страницы.

10. Также отмеченные в шаге 3, параметры Exclude Name, Size и Pos Changes. Это очень полезный параметр. В большинстве случаев имя, размер и позиции компонент на странице меняются часто. Что бы избежать подсвечивания этих общих свойств данный параметр исключает их из подсвечивания. Попробуйте снять отметку с данного параметра и изменить эти свойства.

Выполнение отчета.

Обзор.

После создания отчета, отображение и создание отчета в электронном формате, выполним следующие шаги. Имеется несколько путей получить отчет на бумаге или в электронных форматах. Данная глава показывает различные пути для показа отчета и также простую печать.

Выполнение отчетов.

Одно из общих возможностей использования Rave это выполнение отчета. Выполнение отчета позволяет пользователю увидеть результат разработки отчета. Выполнение подобно тому, что многие разработчики знают как компиляция и в действительности происходит некоторая внутренняя «компиляция».

Есть несколько различных путей, как может быть выполнен отчет. Это делается или через меню Project, используя функциональную клавишу F9, или выбирая иконку Execute Report в панели проекта.

Использование функциональной клавиши F9 является наиболее подходящим методом, так как это часто повторяемое и общее действие при разработке отчета.

При использовании любого пути для выполнения отчета, пользователю предоставляются различные параметры. Диалог Output Options показывает различные параметры доступные во время выполнения.

Позже в этой главе мы объясним каждый параметр в деталях.

Диалог предпочтений.

Перед тем как проходить по каждому параметр, есть несколько предпочтений, которые должны быть объяснены, что бы понять выполнение отчетов. Перейдите в меню Edit и выберите пункт Preferences, после чего появится диалог предпочтений.

На закладке Printing в диалоге предпочтений есть несколько различных параметров , которые можно изменить и которые оказывают влияние на выполнение отчета. Некоторые из параметров могут быть установлены здесь, но также дублируются и в диалоге Output Options, который появляется перед выполнением. В данной главе каждый из параметров будет объяснен.

В области Output Options диалога Printing Preferences, параметр Show Setup Dialog устанавливает должен ли показываться диалог Output Options (как показано здесь) при выполнении отчета. Иногда выгоднее запретить диалог Output Options, особенно во время разработки или тестирования. Но это означает, что параметры, содержащиеся здесь, должны быть установлены перед скрытием данного диалога. Также, любые изменения должны быть сделаны или путем повторной активации диалога или указание их в диалоге предпочтений.

По умолчанию устройство вывода отчета задается установками в Print Destination диалога Printing Preferences и отражается в диалоге Output Options. Изменение значений в области Print Destination диалога Printing Preferences имеет прямой эффект на значения по умолчанию в диалоге Output Options. Есть два параметра, которые можно выбрать: просмотр и принтер. Выбор одного из них делается при помощи радио кнопок, делает этот параметр значением по умолчанию и когда диалог Output Options появляется, данное значение по умолчанию оказывается выбранным.

Параметр Preview Grid действует тем же образом как сетка Grid (линии которой видны в дизайнере страниц) во время разработки. Данные параметры позволяют отображать сетку на окне просмотра. Установки сетки позволяют изменять Print Preview Page, включая изменение цвета, стиля и шага сетки. Если оба значения шага сетки, горизонтальный и вертикальный, будут установлены в 0, то сетка будет отсутствовать. Но указание чисел в установках горизонтально и вертикального шага, размещает сетку на Print Preview Page. Цвет линий изменяет цвет сетки. Стиль линий задается через выпадающее меню.

Параметры просмотра, имеют эффект только на просмотр. Имеется шесть параметров, которые можно установить. При использовании просмотра, окно отображается по умолчанию в нормальном состоянии. Подобно другим окнам Windows, окно просмотра можно минимизировать или максимизировать. Для установки используйте выпадающее меню в настройках Initial Window State.

Параметр Zoom Factor показывает по умолчанию процент увеличения (zoom) при первом показе просмотра. Параметр Zoom Increment указывает процент изменения Zoom при каждом нажатии на иконку Zoom In/Zoom Out. Как и дизайнер страниц, окно просмотра может иметь горизонтальную линейку, вертикальную линей или обе линейки, путем указания в Ruler Type (используйте выпадающее меню для выбора). Единицы измерения могут быть заданы или в дюймах или в сантиметрах.

Параметр ShadowDepth задает уровень тени окна просмотра и только для эстетики.

Параметр Monochrome Preview Display, сделан для совместимости с некоторыми видео картами, на которых могут быть проблемы при показе отчета в цвете. Это не рекомендовано для использования, только при необходимости.

Просмотр отчета.

Поскольку Preview первично используется для предварительного просмотра отчета, имеют много возможностей, гораздо больше, чем это интуитивно понятно по их именам.

Начнем выполнение отчета. Когда появится диалог Output Options, радио кнопку выбора можно отметить. Нажатие OK продолжит выполнение в режиме просмотра.

Окно просмотра используется для просмотра вывода сгенерированного отчета. Вид вывода на экран отличается от вывода на принтере. Вывод не экран базируется на постраничном выводе. Наверху окна просмотра есть панель, которая позволяет навигацию по отчету и другие функции, которые будут объяснены в следующих абзацах.

Большинство функций разрешенных в окне просмотра могут быть выполнены или с помощью панели или через меню окна просмотра. Мы пройдемся по функциям меню и объясним их в оставшейся части данной главы.

Первая группа иконок (разделенная вертикальной линией в панели), может быть найдена в меню File. Они используются для открытия, сохранения, печати или выхода из просмотра отчета.

Несмотря на то, что окно просмотра показывает текущий отчет их дизайнера, оно также позволяет загрузить предыдущий сохраненный отчет (расширение NDR). Это можно выполнить выбором пункт Open из меню File. Появится диалог, запрашивающий требуемый файл отчета. Когда файл NDR, текущий отчет, который был открыт, отменяется. Это не означает, отчет не может быть повторно сгенерирован. Для получения предыдущего отчета, просто повторите его генерацию, и выбери просмотр. Единственный отчет, который можно повторно регенерировать, это отчет который был перед этим просмотрен. Другие отчеты могут быть повторно просмотрены, только если они были сохранены или путем открытия их проектов и повторного выполнения.

Пункт Save As используется для сохранения отчета из просмотра. Выберите пункт, и появится диалог сохранения файла. Используйте этот диалог для сохранения текущего отчета в различные форматы, включая PDF и HTML (эти два формата будут рассмотрены позже в данной главе). Другой формат, в который может быть сохранен отчет, это NDR тип отчета, который является снимком текущего отчета.

Поскольку отчеты могут печататься напрямую, выбрав Execute и затем Printer, окно просмотра также предоставляет эту функцию, поскольку часто необходимо проверять просмотр до проведения подлинной печати.

Отставшие функции напрямую влияют на просмотр отчета на окне просмотра. Вторая секция кнопок на панели, это пункты в меню Page, которые используются для навигации между страницами. Кнопки для управления данными функциями сделаны привычными для пользователей баз данных, поскольку они выполняют похожие функции. Первая кнопка используется для перемещения на первую страницу отчета. Вторая кнопка для перемещения на предыдущую страницу отчета. Третья для перемещения на следующую страницу и последняя на последнею страницу отчета. На панели есть индикатор, показывающий текущую страницу и общее количество страниц. Этот индикатор страниц, также используется для перемещения на конкретную страницу, введя номер в поле ввода. Или используя пункт Go to Page в меню Page. Например, введя 10 в данном поле, мы перейдем на 10 страницу отчета (при условии, что есть 10 или более страниц).

Масштабирование также доступно в просмотре. Иконка лупы, с символом плюса увеличивает масштаб изображения страницы, а с символом минуса уменьшает. Есть также поле для указания коэффициента масштабирования вручную. Просто введите число в данном поле, и просмотр будет масштабирован на указанный процент.

Есть также два предопределенных значения, для быстрого масштабирования. Первое Fit to Page Width – установить масштаб по ширине страницы. И второе Fit to Page, вписать всю страницу в размеры окна. Это может использоваться для просмотра страницы целиком на экране. Побочным эффектом этого является то, что страницу будет видно целиком, но содержимое будет трудно читать. Обычно это используется для общей оценки отчета.

Выход их просмотра может быть сделан, или нажатием на иконку с изображением двери, или нажатием на стандартную иконку закрытия окна "X", как и для всех остальных стандартных окон Windows.

Вывод на принтер.

Печать может быть выполнена, как указано ранее, через окно просмотра или напрямую при выполнении отчета и выбора вывода на принтер в области Report Destination. Надо заметить, что диалог Output Options немного отличается от диалога в Rave Designer и Print Preview.

Диалог Output Options, который вызывается из дизайнера Rave Designer, имеет больше параметров, чем просто печать как показано на картинке.

В диалоге Output Options имеется кнопка Setup для печати. Кнопка расположена под кнопкой Cancel и используется для настройки принтера перед печатью. Это включает такие параметры, как печать в режиме портрет или альбом, разрешение принтера, глубина цвета, размер бумаги и другие.

Диалог также включает такие параметры, как количество копий, порядок сортировки копий и дуплексная печать.

В диалоге Output Options, вызванном из просмотра отчета (смотри картинку), доступно несколько дополнительных параметров. Параметр Print Range имеет три установки. «All» означает печатать все страницы отчета. «Selection» означает печатать отдельные страницы отчета, не обязательно подряд, например "1,3,5,7" или "1,9-5,20". «Pages» означает печатать диапазоны страниц, например "1-10" или "15-19".

Панель выравнивания.

Панель выравнивания используется для выравнивания, упорядочивания и перемещения групп компонент на странице. Важно заметить, что некоторые функции имеют смысл, только если выбрано более одного компонента.

Первый шаг выбрать компоненты, которые требуется выровнять. Для выбора нескольких компонентов, удерживайте клавишу shift и указывайте мышью каждый компонент, который требуется выровнять.

Для большинства функций выравнивания. Первый выбранный компонент определяет позицию выравнивания. Например, при выборе выравнивание влево, все выбранные компоненты выравниваются относительно первого выбранного компонента. Красная линия на иконке показывает тип выравнивания.

Панель выравнивания разделена на четыре секции. Первые две секции управляют горизонтальным и вертикальным выравниванием. Все компоненты могут быть выровнены по краю, центру или по расстоянию между ними.

Порядок выравнивания определяет Z порядок (глубину по оси Z) между компонентами. Порядок выравнивания не требует, что бы было выбрано более одного компонента. Для установки Z порядка выберите компонент и вызовите контекстное меню. Из подменю Order выберите одно из четырех действий: переместить вперед (Move Forward), переместить назад (Move Behind), поместить наверх (Bring to Front) или поместить вниз (Send to Back). Рисунок справа показывает прямоугольник над эллипсом. Для перемещения эллипса позади прямоугольника, выберите в контекстном меню пункт Send to Back из подменю Order.

Есть еще четыре кнопки на панели выравнивания, это инструмент для перемещения, который позволяет перемещать компонент или группу компонент. Для перемещения выбранных компонент, нажимайте на соответствующую стрелку для перемещения в нужном направлении.

Вывод в файл.

NDR и PRN файлы.

Печать в файл может быть выполнена несколькими путями. Мы обсудим два, которые могут быть сделаны прямо из диалога Output Options. Диалог Output Options доступен при выполнении отчета (используйте клавишу F9 или выполните через меню Project).

Файл NDR это внутренний формат Rave, снимок отчета. Файл NDR может быть открыт и просмотрен из окна просмотра, но не может быть изменен или отредактирован в дизайнере Rave.

Файл PRN это Native Printer Output файл. Когда данный параметр выбран, информация, которая обычно посылается на принтер для печати, посылается в файл. Данный файл получает имя, указанное пользователем.

Для создания файла, просто выберите нужный формат и затем укажите имя в поле ввода File.

Файл формата NDR также можно сделать, используя пункт Save As из меню File окна просмотра. Используйте выпадающее меню Save as и выберите имя файла для создания NDR файла.

Есть также и другие пути печати в файл. Здесь только два формата. Мы обсудим PDF и HTML файлы в следующей главе.

HTML.

Rave имеет возможность печатать отчеты как HTML файлы. Это дает возможность просто создавать отчеты доступные через Интернет и Интранет. HTML файлы могут быть созданы в визуальном дизайнере и в окне просмотра.

Для сохранения отчета, как HTML файла из визуального дизайнера, во-первых, вызовите Output Options диалог. Сделайте это с помощью пункта Execute Report из меню Project или клавишей F9.

В диалоге Output Options, выберите параметр File в области Report Destination. Используя выпадающее меню Format, выберите тип HTML. Щелкните по иконке диска, выберите путь, где сохранять файл и имя HTML файла.

После сохранения отчета и отформатирован, полезно сначала просмотреть отчет. Просмотр отчета выполняется выбором пункта Preview в диалоге Output Options. После просмотра отчета выберите Save As в меню File. Это вызовет диалог Save File, откуда отчет может быть сохранен в HTML.

Для сохранения в HTML формате, в выпадающем меню Save as, выберите HTML файлы. Затем ведите имя нового HTML файла в поле ввода File name. Когда будете готовы, нажмите кнопку Save.

Каждая страница отчета, будет сохранена как отдельный HTML файл. Например, трехстраничный отчет произведет три страницы HTML. На каждой странице будут ссылки на предыдущую или следующую страницы. Однажды сохраненный HTML файл можно будет просматривать любым браузером.

PDF.

Подлинно полезный отчет, этот тот отчет, который может использоваться на различных платформах. Rave дает эту возможность через создание PDF файла. Отчет может быть сохранен в PDF формате, и затем через использование бесплатного продукта Adobe Acrobat Reader, любой человек может открыть, просмотреть и отпечатать отчет.

Это доступно через пункт Execute Report (и также F9) в меню визуального редактора File или через пункт Save As меню File в просмотре отчета. Использование просмотра отчета, позволяет пользователю просмотреть отчет перед выводом в файл PDF формата.

После выбора Execute появится диалог Output Options, из которого можно выбрать формат. И также указать имя PDF файла.

В просмотре отчета, используйте пункт Save As, который выведет диалог Save File, откуда Вы можете сохранить отчет в PDF формате, также указав имя файла.

Для сохранения в PDF, в выпадающем меню Save as, выберите Adobe PDF. Затем, укажите имя нового PDF файла в поле ввода File name. Затем нажмите кнопку Save.

RTF.

Rave также позволяет сохранять отчет в RTF файле (Rich Text Format). Данный формат файла можно загружать во многие текстовые процессоры для широкого спектра задач. Например, ваш отчет может быть включен документ компании как приложение. Или отчет, может быть загружен в текстовый процессор, затем некоторые строки, для привлечения особого внимания, могут быть отредактированы (раскрашены или выделены жирным шрифтом).

Это доступно через пункт Execute Report (и также F9) в меню визуального редактора File или через пункт Save As меню File в просмотре отчета. Использование просмотра отчета, позволяет пользователю посмотреть отчет перед выводом в файл RTF формата.

После выбора Execute появится диалог Output Options, из которого можно выбрать формат. И также указать имя файла.

В просмотре отчета, используйте пункт Save As, который выведет диалог Save File, откуда Вы можете сохранить отчет в RTF формате, также указав имя файла.

Для сохранения в RTF, в выпадающем меню Save as, выберите Adobe PDF. Затем, укажите имя нового RTF файла в поле ввода File name. Затем нажмите кнопку Save.

Упражнения.

Упражнение 9: изменение предпочтений печати.

Смена назначения печати.

1. перед началом выполнения данного упражнения, создайте новый проект и поместите несколько видимых компонент на страницу;

2. во-первых, перейдите в закладку Printing Preferences, или с помощью иконки Edit Preferences на панели дизайнера, или выберите пункт Preferences в меню Edit;

3. выберите Printing в области Preferences (с левой стороны окна);

4. посмотрите на область Print Destination и выберите Preview;

5. теперь закройте окно, нажав кнопку OK;

6. выполните отчет, нажав клавишу F9 или пункт Execute в меню File;

7. когда появится диалог Output Options, убедитесь, что пункт Preview отмечен. Нажмите кнопку Cancel для окончания;

8. теперь откройте снова Printing Preferences и выберите Printer как Print Destination. Нажмите кнопку OK для окончания;

9. выполните снова отчет и в диалоге Output Options, убедитесь, что теперь выбран Printer.

Изменение настроек.

1. перед началом выполнения данного упражнения, создайте новый проект и поместите несколько видимых компонент на страницу;

2. во-первых, перейдите в закладку Printing Preferences, или с помощью иконки Edit Preferences на панели дизайнера, или выберите пункт Preferences в меню Edit;

3. затем, убедитесь, что Preview выбрано в области Print Destination;

4. снимите отметку Show Output Options Dialog в области Output Options.

5. выберите OK для закрытия диалога Preferences;

6. выполните отчет, нажав клавишу F9 или пункт Execute в меню File. Обратите внимание, что диалог Output Options теперь не появляется; вместо этого теперь сразу начинается просмотр отчета. Если принтер был выбран в области Print Destination, то отчет посылается на принтер;

7. для возращения обратно вызова диалога Output Options, перейдите в Printing Preferences и снова поставьте отметку на Show Output Options Dialog в области Output Options.

Линии сетки и параметры просмотра.

1. перед началом выполнения данного упражнения, создайте новый проект и поместите несколько видимых компонент на страницу;

2. во-первых, перейдите в закладку Printing Preferences, или с помощью иконки Edit Preferences на панели дизайнера, или выберите пункт Preferences в меню Edit;

3. затем убедитесь, что Preview выбрано в Print Destination, и снимите отметку с Show Output Options Dialog, в области Output Options. Мы будем работать с Preview в данном упражнении, поскольку использование Print Destination и Show Output Options Dialog, для выполнения быстрее в Preview;

4. находясь в диалоге Printing Preferences, убедитесь, что начальные значения для параметров Preview Grid и Preview Options точно такие, как показано на рисунке.

5. нажмите OK, для выхода;

6. выполните отчет и просто посмотрите на окно просмотра;

7. теперь закройте окно просмотра и откройте Printing Preferences;

8. В параметрах Preview Grid, измените Horizontal Spacing и Vertical Spacing на 1. затем измените цвет;

9. нажмите OK, для выхода;

10. выполните отчет и обратите внимание на линии сетки. Данные линии не появятся в отчете на бумаге, но здесь они нужны для оценки форматирования.

11. теперь закройте просмотр и перейдите снова в Printing Preferences. Измените Line Style в области Preview Grid на Dash. также, смените Initial Window State на Minimized.

12. затем в Preview Options, смените Ruler Type на BothIn. Это покажет обе измерительные линейки в дюймах в просмотре. Также смените Shadow Depth на 10.

13. нажмите OK, для выхода;

14. выполните отчет;

15. обратим внимание, что вначале просмотр минимизирован. Это достигнуто установкой параметра Initial Window State. Для расширения окна нажмите первую или вторую кнопки;

16. один раз восстановите, и максимизируйте отчет. Обратим внимание на некоторые вещи. Во-первых, мы видим пунктирные линии сетки на странице. Это может быть полезно для определения выравнивания на странице. Также увидим обе измерительные линейки. И с правого края страницы мы увидим глубокую тень;

17. По окончанию вернемся в диалог Printing Preferences. Возвратим все установки обратно в их начальное значение. Рисунок показывает нам наши значения. Данные значения нам потребуются в следующем упражнении.

Упражнение 10: создание системно независимых файлов.

1. перед началом, создайте новый проект и поместите не него четыре страницы с текстом и объектами;

2. свяжите все четыре страницы вместе. Выбор страниц и свойств панели был рассмотрен в предыдущей главе. Выберите первую страницу и в панели свойств, используя, выпадающее меню в GotoPage выберите Page2. сделайте это для каждой из страниц. Выберите page 2 и сделайте GotoPage равным Page3. Выберите page 3 и сделайте GotoPage равным Page4;

3. затем перейдите в окно просмотра путем выполнения отчета. Выберите Preview из диалога Output Options.

4. вверху окна просмотра на панели, должно быть поле ввода, в котором было число 1. теперь там должно быть Page 1 of 4.

Навигация по просмотру.

5. поскольку теперь более одной страницы, используйте кнопки навигации на панели или меню Page. Используйте Go to Page # для перехода на любую страницу отчета.

6. затем, используя инструмент zoom, сделайте отчет удобным для просмотра страниц отчета. Это также позволит вам перемещение по просмотру.

Создание NDR файла через просмотр.

7. для создания NDR файла (файл снимка Rave) из окна просмотра, выберите пункт Save As меню File;

8. когда появится диалог Save File, в выпадающем меню Save as type выберите NDR files. И введите имя в поле ввода File name, например мы Text.ndr. Нажмите Save для выхода;

9. хотя файл уже в окне просмотра, попробуем открыть Test.ndr файл;

10. выберите Open в меню File;

11. появится Open File диалог. Найдите файл Test.ndr в той папке, куда Вы его поместили. Нажмите Open, для выхода;

12. просмотр будет выглядеть точно также, поскольку мы не изменяли отчет. Но, посмотрим наверх окна просмотра, там показывается имя просматриваемого файла. Если же Вы будете просматривать различные NDR файлы, их имена всегда будут показываться там. Ничего в NDR файле не может быть изменено; этот путь только для просмотра отчета.

Создание PDF файла через просмотр.

13. поскольку нам этот файл больше не нужен, закройте окно просмотра. Выполните файл и выберите снова Preview.

14. теперь выберите пункт Open из меню File. (от переводчика, из дальнейшего контекста, похоже, что имеется в виду Save AS)

15. в диалоге Save File, выберите Adobe PDF в выпадающем меню Save as type. Затем укажите имя в поле ввода File name, например test.pdf.

16. Нажмите Save, для выхода;

17. в данной точке мы можем перейти туда, где мы сохранили наш файл и открыть PDF файл. Если у вас нет программы просмотра PDF, то сходите на http://www.adobe.com/ и загрузите бесплатный вариант.

Создание HTML файлов.

18. в окне просмотра выберите Open из меню File;

19. в диалоге Save File, выберите HTML File в выпадающем меню Save as type. Затем укажите имя в поле ввода File name;

20. Нажмите Save, для выхода;

21. Теперь мы можем перейти туда, где мы сохранили наш файл. Мы сохранили наши html файлы в My Documents. Обратите внимание, что здесь четыре страницы test.html, с последовательными номерами после слова test. Каждая страница в отчете представлена отдельным файлом;

22. ниже показана первая страница test.html. заметим, что внизу есть ссылки для навигации по страницам.

Упражнение 11: печать отчета через просмотр.

1. в окне просмотра выберите пункт Print из меню File;

2. появится диалог Output Options. Используйте любой диапазон страниц для печати;

3. по окончанию закройте окно просмотра;

4. затем выполните отчет и выберите принтер. Это пошлет отчет на принтер.

Упражнение 12: печать в файл (NDR и PRN).

1. выполните Execute и выберите File;

2. в выпадающем меню Format, есть только два выбора. Rave Format (.NDR) и Native Printer Output (.PRN).

3. сделайте ваш выбор.

5. в поле ввода File, укажите имя файла;

6. нажмите OK для выхода

Панели утилит.

Есть панели и есть панели.

Несмотря на то, что все панели названы панелями, на самом деле есть два различных типа, отличающихся типом функций, это панели инструментов и панели компонент.

Инструменты обычно предназначены для изменения элементов, расположенных на странице, обычно компоненты. А компоненты это объекты, помещаемые на страницу, например регион (Region), графические примитивы (Shape), линии (Line) и штрих коды (Barcode). Для более подробной информации смотрите главу «Обзор компонент».

В данной главе мы рассмотрим панели инструментов, на которых расположены (палитра цветов, инструменты выравнивания и другие.), предназначенные для изменения компонент. Панели инструментов включают: панель выравнивания (Alignment), панель палитры цветов (Color Palette), панели заполнения (Fill), панель редактора шрифтов (Font Editor), панель редактора линий (Line Editor), панели проекта (Project) и панель масштабирования (Zoom).

Использование инструмента.

Панели утилит над компонентами и дизайнером страниц. Компонент на странице должен быть выбран до использования панели. Например, для изменения цвета заполнения квадрата, выберите квадрат, затем выберите нужный цвет.

С помощью правой мышки, выберите компонент, и появится контекстное меню, позволяя доступ до пунктов изменения компонента. Данные функции доступны также и с панелей, но просто контекстное меню дает быстрый и простой доступ.

Панель дизайнера.

Панель дизайнера используется для управления предпочтениями страницы. Все элементы панели дизайнера.

Имеют два состояния, свойство компонента, ассоциированное с данной клавишей, меняет свое состояние. Для смены на обратное состояние нажмите на кнопку еще раз. Отжатая кнопка показывает состояние выключено, а нажатая состояние включено.

Activate Grid Делает сетку страницы видимой/невидимой.

Snap To Grid Привязка объектов к узлам сетки.

Grid On Top Определяет, что сетка находится над компонентами или под ними.

Always Show Band Headers Управляет показом заголовков групп (band).

Show Rulers Показывает, убирает измерительные линейки.

Show Waste Area Управляет показом пространства между границами страницы и концом настройки границ.

Edit Preferences Вызывает диалог предпочтений.

Панель палитры цветов.

Палитра цветов используется для смены цвета компонента или цвета заполнения выбранных объектов, таких как линии, текст или область заполнения одного из графических примитивов (круг, эллипс, прямоугольник или квадрат). Палитра цветов разделена на несколько секций, которые показывают пользовательские, стандартные или текущие цвета. Левая кнопка, с правой стороны, определяет первичный, а правая вторичный текущий цвета. Все остальные прямоугольники на палитре цветов позволяют выбрать цвет.

Для смены цвета объекта, выберите компонент и затем левой или правой кнопкой мыши выберите цвет из палитры. Левая кнопка выбирает цвет объекта (первичный цвет), а правая цвет фона (вторичный цвет).

Когда выбран первичный цвет, символ "1" помещается на индикатор цвета на палитре. Соответственно, символ "2" указывает на вторичный цвет.

Для смены цвета объекта (например, Rectangle), выберите его и затем нажмите на нужном вам цвете левой кнопкой мыши. Для смены цвета заполнения, выберите нужный цвет правой кнопкой мыши.

Двойной щелчок, на цвете назначаемым пользователем, (правая сторона) или цвет переднего плана и фона вызывает редактор цвета (Color Editor). В диалоге, пользовательские цвета могут быть созданы путем установки красного, зеленого и синего цветов, также и насыщенность цвета, уменьшая или увеличивая процентное соотношение цвета.

Для создания и сохранения нового цвета, используйте один из пользовательских цветов для ввода в редакторе цвета, затем нажмите клавишу New Color и выберите нужный цвет из диалога цвета. При вызове редактора цветов из одного из пользовательских цветов, новый цвет сохраняется. Если редактор цветов вызывается из первичного или вторичного цвета, цвет сохраняется в эти места, если выбран new color (или щелчком левой или правой кнопки мыши или созданием другого цвета).

Важно заметить, что действительные видимые цвета зависят от настроек компьютера. Если здесь есть цветные объекты, то при переносе отчета с одной системы на другую проверьте, настройки цветов дисплея. При 256-цветныех установках используется только 256 цветов для показа, а при True Color используются миллионы цветов. Для примера, если отчет был создан в True Color, и затем перенесен на систему с 256 цветами, некоторые объекты могут появиться искаженными или иметь неверные градации цвета.

Редактор шрифтов.

Редактор шрифтов может использоваться для смены типа, размера, атрибутов и выравнивания некоторых текстовых компонентов. Его поведение и функционирование очень похоже на панель шрифтов в некоторых текстовых процессорах.

Для изменения установок шрифта текстового компонента, во-первых, выберите компонент. Тип шрифта можно выбрать из выпадающего списка. Аналогично размер можно выбрать из списка доступных размеров. Кнопки (B) Жирный, (I) Курсив и (U) подчеркнутый , переключают состояние текста. Для установки жирного шрифта, просто выберите компонент Text и нажмите на кнопку «B». Клавиша будет находиться в нажатом состоянии до тех пор, пока на нее повторно не нажмут или фокус не перейдет к другому текстовому объекту, который не имеет такого установленного атрибута. Кнопки «I» и «U» работают аналогично. Здесь также есть еще и три кнопки выравнивания текста внутри области и показывают тип выравнивания внутри области, в которой они находятся, это выравнивание влево, вправо и по центру. Все текстовые компоненты имеют свойство Font, которое появляется в панели свойств при выборе компонента. Любые изменения сделанные в свойстве Font, отражаются и на панели редактора шрифтов.

ПРИМЕЧАНИЕ: важно заметить, что если шрифт, выбранный на машине разработчика не доступен на другой машине, Rave назначит какой ни будь другой подобный выбранному шрифт.

Редактор линий.

Используйте редактор линий для изменения стиля и толщины линии или границ графических примитивов. Панель редактора линий имеет несколько вариантов для выбора стиля линии (непрерывная или комбинация точек и тире).

Для смены стиля линии, сначала выберите линию или графический примитив, затем выберите размер в пунктах из Hairline. Окончательно выберите стиль линии.

Для смены толщины непрерывной линии, сначала выберите линию или графический примитив, затем выберите требуемый размер.

Стиль линии (тире, точки), появляется только тогда, когда толщина линии выбрана как hairline. Если линия установлена в определенный стиль (например, тире) и затем ей присваивается толщина, другая чем hairline, то стиль линии изменяется на непрерывный.

Панель проекта.

Панель проекта предоставляет базовую функциональность для проекта. Это дает быстрый доступ для выполнения общих задач при управлении проекта. Все функции панели доступны и через меню Rave.

Первые три иконки управления проектами:

New Project Создает новый проект.

Open Project Открывает предыдущий сохраненный проект.

Save Project Сохраняет текущий проект.

Следующие три иконки управляют специфическими аспектами текущего проекта:

New Report Создает новый отчет, который будет в том же самом файле проекта (.rav file). Может иметь более одного отчета на проект в файле проекта.

New Global Page Создает новую глобальную страницу.

New Data View Позволяет создать новый просмотр данных DataViews, который ассоциирован с текущим проектом. Смотрите главу «Подключение данных» для получения более подробной информации о DataViews.

Две последние иконки управляют текущим выбранным отчетом:

New Page Создает новую страницу в текущем отчете.

Execute Report Выполняет или печатает текущий отчет.

Панель масштабирования.

Панель масштабирования, позволяет пользователю, с помощью Zoom In просмотреть более подробно детали документа, а Zoom Out увидеть общий образ страницы. В панели масштабирования есть несколько путей для работы с документом.

Выпадающее меню масштабирования по проценту, содержит несколько предопределенных значений для уменьшения или увеличения образа страницы. Просто выберите желаемый коэффициент. Если ни одно из них вас не устраивает, то просто введите свое значение в поле ввода.

Другой метод получения нужного размера, это использования иконки лупы с крестом. Перетяните данный инструмент на нужную область, которую надо увеличить.

Для простого изменения размеров, есть две иконки лупы с символами "+" и "-". Ничего не требуется выбирать, что бы использовать данный инструмент. Каждое нажатие на иконку увеличивает и уменьшает образ на значение установленное в предпочтениях. Для установки этого параметра, выберите пункт Preferences в меню Edit. Далее перейдите на закладку Designer. В области, называемой "Zoom Increment", увеличьте или уменьшите величину шага, с помощью кнопок вверх/вниз или просто кажите нужный процент.

Для изменения размера, выбранных элементов, используйте лупу с символом прямоугольника из точек. Вначале, выберите нужные элементы и затем щелкните по иконке. Видимая область будет кадром выбранных элементов.

Используйте кнопку "Page Width" для установки размера по ширине текущей выбранной страницы.

Используйте кнопку "Whole Page" для показа полной текущей страницы.

Упражнения.

Упражнение 13: выравнивание компонент.

В данном упражнении мы продемонстрируем, как выравнивать компоненты. Например, есть шесть пронумерованных строк текста.

1. в начале, бросьте несколько компонент Text на страницу. В данном примере это пронумерованные строки 1-6;

2. строки два, четыре и пять должны быть выровнены. Строки три и шесть также должны быть выровнены;

3. выберите строку два. Это задаст первичный компонент, относительно которого будут выравниваться остальные;

4. удерживая клавишу shift, выберите строки четыре и пять, которые будут выровнены относительно строки два; заметим, что появилась граница с маркерами серого цвета;

5. поскольку все компоненты уже выбраны, нажмите на иконку Align Left Edges на панели выравнивания. Заметим, что все три компонента выровнялись по левому краю;

6. что бы посмотреть, как работает выравнивание, нажмите иконку Align Right Edges на панели выравнивания;

7. пройдитесь по оставшимся функциям панели выравнивания и посмотрите, как они работают;

8. попробуем теперь выравнить второй набор строк. Сначала выберите первичный компонент, как базу для выравнивания, в данном случае, это строка три;

9. затем выберите другие компоненты, которые Вы хотите выравнить, удерживая клавишу shift, выберите строку шесть;

10. затем нажмите на иконку the Align Left Edges для выравнивания компонент.

Упражнение 14: порядок компонент.

Для изменения порядка компонент по Z-оси, должны использоваться иконки на панели выравнивания.

1. чтобы начать упражнение, нам нужны компоненты на странице. Это могут быть любые компоненты. В данном примере используются прямоугольник, овал и круг;

2. сначала выберите компонент, который будет перемещать. В примере будем перемещать прямоугольник за овал. Посмотрим в дереве проекта размещение компонента Rectangle;

3. как только прямоугольник будет выбран, нажмите иконку Move Behind на панели выравнивания. Заметим, что после нажатия прямоугольник еще никуда не поместился, но в дереве проекта уже сменил свою позицию на шаг выше;

4. теперь нажмите на иконку Move Behind button еще раз. Прямоугольник переместился и в дереве проекта на странице за овал;

5. для второго компонента, выберите круг и нажмите на иконку Move Behind. Круг переместился по дереву ин странице за овал;

6. щелкните по иконке Move Behind еще раз и заметьте, что круг перемещается по дереву, но остается сзади овала;

Упражнение 15: привязка к сетке.

Привязка к сетке перемещение относится к перемещению и изменению размера компонент к узлам сетки на странице.

1. сначала, вызовите диалог Preferences, пункт Preferences меню Edit;

2. выберите закладку Default и посмотрите в область Grid Spacing;

3. В Grid Spacing смените, значение на .02. затем посмотрите на область, называемую Draw Grid Every;

4. в Draw Grid Every, введите 1 line (напечатайте или используйте выпадающий список). Draw Grid Every 1 line, будет показывать каждую строку сетки. Если это сменить на Draw Grid Every 3 lines, то будет показана только каждая третья строка сетки;

5. затем перейдите в меню Project и выберите New. Это создаст новый проект, также и новую страницу отчета, которая будет базироваться на предпочтениях, которые мы сменили в предыдущих шагах. Помните, что линии сетки используются только для разработки отчета и не показываются при его исполнении;

6. прейдите в панель дизайнера и нажмите на иконку Snap To Grid;

7. теперь бросьте прямоугольник на страницу;

8. затем перемещайте прямоугольник и обратите внимание, что прямоугольник перемещается только по сетке. Попробуйте сделать тоже самое кнопками перемещения.

9. опять перейдите в панель дизайнера и нажмите на иконку Snap To Grid, для отключения привязки;

10. пробуйте перемещать прямоугольник и обратите внимание, что теперь прямоугольник перемещается и между узлами сетки.

Упражнение 16: изменение размера линии и цвета прямоугольника.

1. создайте новый отчет;

2. бросьте прямоугольник на страницу;

3. посмотрите на панель палитры цветов. Обратите внимание, что на конкретных цветах есть символы 1 и 2, которые указывают первичный и вторичный цвета;

4. что бы сделать изменение цвета более заметным в примере, мы изменим ширину линии прямоугольника. Перейдем на панель редактора. Выберем прямоугольник. Затем изменим в выпадающем списке толщину линии. В примере сменено с hairline на 2.25 пункта;

5. Щелкните левой кнопкой мыши на любом цвете в панели цветов. В данном примере был выбран цвет Olive. Заметьте, что цвет границы сменился на оливковый цвет. Также обратите внимание, что изменился первичный цвет. Первичный цвет определяет цвет границы;

6. Щелкните правой кнопкой мыши на любом цвете. В примере был выбран цвет Blue. Заметим, что прямоугольник закрасился синим цветом. Также заметим, что изменился вторичный цвет. Вторичный цвет определяет цвет заливки.

Упражнение 17: смена шрифтов.

1. создайте новую страницу отчета;

2. бросьте на нее четыре компоненты Text;

3. выберите компонент и посмотрите на панель шрифтов;

4. в выпадающем меню отображаются имена шрифтов, выберите подходящий шрифт;

5. перейдите на следующий компонент, и повторите шаги 3 и 4. повторите это же для оставшихся компонент;

6. Также попробуйте изменять размеры шрифтов. И конечно атрибуты Bold, Italic и Underline;

7. Три оставшихся кнопки управляют выравниванием влево, вправо и по центру. Попробуйте поработать и с ними.