Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

Top = 24

Width = 241

Height = 21

TabOrder = 2

Text = 'Messenger'

end

end

unitUnit1;

interface

usesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Winsvc;

typeTForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Label1: TLabel;

procedureButton1Click(Sender: TObject);

procedureStopService(ServiceName: String);

procedureButton2Click(Sender: TObject);

procedureStartService(ServiceName: String);

private

{ Private declarations }

public

{ Public declarations }

end;

varForm1: TForm1;

implementation

{$R *.DFM}

procedureTForm1.Button1Click(Sender: TObject);

begin

StopService(Edit1.Text);

end;

procedureTForm1.StopService(ServiceName: String);

var

schService, schSCManager: DWORD;

p: PChar;

ss: _SERVICE_STATUS;

begin

p:= nil;

schSCManager:= OpenSCManager( nil, nil, SC_MANAGER_ALL_ACCESS);

ifschSCManager = 0 thenRaiseLastWin32Error;

try

schService:=OpenService(schSCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);

ifschService = 0 thenRaiseLastWin32Error;

try

if notControlService(schService, SERVICE_CONTROL_STOP, SS) then RaiseLastWin32Error;

finally

CloseServiceHandle(schService);

end;

finally

CloseServiceHandle(schSCManager);

end;

end;

procedureTForm1.Button2Click(Sender: TObject);

begin

StartService(Edit1.Text);

end;

procedureTForm1.StartService(ServiceName: String);

var

schService, schSCManager: Dword;

p: PChar;

begin

p:= nil;

schSCManager:= OpenSCManager( nil, nil, SC_MANAGER_ALL_ACCESS);

ifschSCManager = 0 thenRaiseLastWin32Error;

try

schService:=OpenService(schSCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);

ifschService = 0 thenRaiseLastWin32Error;

try

if notWinsvc.startService(schService, 0, p) thenRaiseLastWin32Error;

finally

CloseServiceHandle(schService);

end;

finally

CloseServiceHandle(schSCManager);

end;

end;

end.

functionRevealHint (Control: TControl): THintWindow;

{----------------------------------------------------------------}

{ Демонстрирует всплывающую подсказку для определенного элемента }

{ управления (Control), возвращает ссылку на hint-объект, }

{ поэтому в дальнейшем подсказка может быть спрятана вызовом }

{ RemoveHint (смотри ниже). }

{----------------------------------------------------------------}

var

ShortHint: string;

AShortHint: array[0..255] ofChar;

HintPos: TPoint;

HintBox: TRect;

begin

{ Создаем окно: }

Result := THintWindow.Create(Control);

{ Получаем первую часть подсказки до '|': }

ShortHint := GetShortHint(Control.Hint);

{ Вычисляем месторасположение и размер окна подсказки }

HintPos := Control.ClientOrigin;

Inc(HintPos.Y, Control.Height + 6); <<<< Смотри примечание ниже

HintBox := Bounds(0, 0, Screen.Width, 0);

DrawText(Result.Canvas.Handle, StrPCopy(AShortHint, ShortHint), -1, HintBox, DT_CALCRECT orDT_LEFT orDT_WORDBREAK orDT_NOPREFIX);

OffsetRect(HintBox, HintPos.X, HintPos.Y);

Inc(HintBox.Right, 6);

Inc(HintBox.Bottom, 2);

{ Теперь показываем окно: }

Result.ActivateHint(HintBox, ShortHint);

end; {RevealHint}

procedureRemoveHint ( varHint: THintWindow);

{----------------------------------------------------------------}

{ Освобождаем дескриптор окна всплывающей подсказки, выведенной }

{ предыдущим RevealHint. }

{----------------------------------------------------------------}

begin

Hint.ReleaseHandle;

Hint.Free;

Hint := nil;

end; {RemoveHint}

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

Nomadicпредлагает следующее:

{$R CURSORS.RES}

const

crZoomIn = 1;

crZoomOut = 2;

Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');

Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');

С вашей программой должен быть слинкован файл ресурсов, содержащий соответствующие курсоры.

С помощью программы Image Editor упакуйте курсор в RES-файл. В следующем примере подразумевается, что вы сохранили курсор в RES-файле как «cursor_1», и записали RES-файл с именем MYFILE.RES.

{$R c:\programs\delphi\MyFile.res} { Это ваш RES-файл }

constPutTheCursorHere_Dude = 1; { произвольное положительное число }

procedurestuff;

begin

screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, PChar('cursor_1'));

screen.cursor := PutTheCursorHere_Dude;

end;

… вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!

procedureForm1.FormCreate(Sender: TObject);

varx: integer;

begin

BatchMove1.Execute;

Source.Open;

Target.Exclusive := True;

Target.Open;

Source.IndexDefs.Update;

forx := 0 toSource.IndexDefs.Count – 1 do

Target.AddIndex(Source.IndexDefs[x].Name, Source.IndexDefs[x].Fields, Source.IndexDefs[x].Options);

Source.Close;

Target.Close;

end;

Nomadicотвечает:

Удобней всего, например, так —

withbmovMyBatchMove do begin

Mode := bmCopy;

RecordCount := 1;

Execute;

R Destination.Delete;

end;

Где bmovMyBatchMove – экземпляр класса TBatchMoveиз VCL.

Неправда Ваша! ;)

Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:

увеличивает в создаваемых таблицах в полях типа NUMBERколичество значащих цифр после запятой (не помню – возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.