Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
CloseServiceHandle(schSCManager);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StartService(Edit1.Text);
end;
procedure TForm1.StartService(ServiceName: String);
var
schService, schSCManager: Dword;
p: PChar;
begin
p:=nil;
schSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if schSCManager = 0 then RaiseLastWin32Error;
try
schService:=OpenService(schSCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
if schService = 0 then RaiseLastWin32Error;
try
if not Winsvc.startService(schService, 0, p) then RaiseLastWin32Error;
finally
CloseServiceHandle(schService);
end;
finally
CloseServiceHandle(schSCManager);
end;
end;
end.
Прямой вызов метода Hint
Delphi 1
function RevealHint (Control: TControl): THintWindow;
{----------------------------------------------------------------}
{ Демонстрирует всплывающую подсказку для определенного элемента }
{ управления (Control), возвращает ссылку на hint-объект, }
{ поэтому в дальнейшем подсказка может быть спрятана вызовом }
{ RemoveHint (смотри ниже). }
{----------------------------------------------------------------}
var
ShortHint: string;
AShortHint: array[0..255] of Char;
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 or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
OffsetRect(HintBox, HintPos.X, HintPos.Y);
Inc(HintBox.Right, 6);
Inc(HintBox.Bottom, 2);
{ Теперь показываем окно: }
Result.ActivateHint(HintBox, ShortHint);
end; {RevealHint}
procedure RemoveHint (var Hint: THintWindow);
{----------------------------------------------------------------}
{ Освобождаем дескриптор окна всплывающей подсказки, выведенной }
{ предыдущим RevealHint. }
{----------------------------------------------------------------}
begin
Hint.ReleaseHandle;
Hint.Free;
Hint := nil;
end; {RemoveHint}
Строка с комментарием <<<< позиционирует подсказку ниже элемента управления. Это может быть изменено, если по какой-то причине вам необходима другая позиция окна с подсказкой.
Как использовать свои курсоры в программе? I
Nomadic предлагает следующее:
{$R CURSORS.RES}
const
crZoomIn = 1;
crZoomOut = 2;
Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');
Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');
С вашей программой должен быть слинкован файл ресурсов, содержащий соответствующие курсоры.
Как использовать свои курсоры в программе? II
С помощью программы Image Editor упакуйте курсор в RES-файл. В следующем примере подразумевается, что вы сохранили курсор в RES-файле как «cursor_1», и записали RES-файл с именем MYFILE.RES.
{$R c:programsdelphiMyFile.res} { Это ваш RES-файл }
const PutTheCursorHere_Dude = 1; { произвольное положительное число }
procedure stuff;
begin
screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, PChar('cursor_1'));
screen.cursor := PutTheCursorHere_Dude;
end;
Компоненты
BatchMove
Пересборка индексов с помощью TBatchMove
Delphi 1
… вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!
procedure Form1.FormCreate(Sender: TObject);
var x: integer;
begin
BatchMove1.Execute;
Source.Open;
Target.Exclusive := True;
Target.Open;
Source.IndexDefs.Update;
for x := 0 to Source.IndexDefs.Count – 1 do
Target.AddIndex(Source.IndexDefs[x].Name, Source.IndexDefs[x].Fields, Source.IndexDefs[x].Options);
Source.Close;
Target.Close;
end;
Есть некоторая таблица и требуется при нажатии на кнопку создавать таблицы такой же структуры. Подскажите, как это удобнее всего сделать?
Nomadic отвечает:
Удобней всего, например, так —
with bmovMyBatchMove do begin
Mode := bmCopy;
RecordCount := 1;
Execute;
R Destination.Delete;
end;
Где bmovMyBatchMove – экземпляр класса TBatchMove из VCL.
Неправда Ваша! ;)
Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:
увеличивает в создаваемых таблицах в полях типа NUMBER количество значащих цифр после запятой (не помню – возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.
Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.
Кроме того, в предложенном выше варианте еще и запись удалять приходится…:)
Решалась же эта проблема следующим способом:
procedure CopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);
var
i: Integer;
bActive: Boolean;
SrcDatabase, DestDatabase: TDatabase;
iSrcMemSize, iDestMemSize: Integer;
pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;
bNeedAllFields: Boolean;
begin
SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);
try
DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);
try
bActive := SrcTable.Active;
SrcTable.FieldDefs.Update;
iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);
pSrcFldDes := AllocMem(iSrcMemSize);
if pSrcFldDes = nil then begin
raise EOutOfMemory.Create('Не хватает памяти!');
end;
try
SrcTable.Open;
Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));
SrcTable.Active := bActive;
FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);
with CrtTableDesc do begin
StrPcopy(szTblName, DestTable.TableName);
StrPcopy(szTblType, 'DBASE');
if (Length(cpyFields[0] ) = 0) or (cpyFields[0] = '*') then begin
bNeedAllFields := True;
SrcTable.FieldDefs.Update;
iFldCount := SrcTable.FieldDefs.Count;
end else begin
bNeedAllFields := False;
iFldCount := High(cpyFields) + 1;
end;
iDestMemSize := iFldCount * Sizeof(FLDDesc);
CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);
if CrtTableDesc.pFLDDesc = nil then begin
raise EOutOfMemory.Create('Не хватает памяти!');
end;
end;
try
if bNeedAllFields then begin
for i := 0 to CrtTableDesc.iFldCount - 1 do begin
Move(PFieldDescList(pSrcFldDes)^[i], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
end;
end else begin
for i:=0 to CrtTableDesc.iFldCount-1 do begin
Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo – 1], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
end;
end;
Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));
finally
FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);
end;
finally
FreeMem(pSrcFldDes, iSrcMemSize);
end;
finally
Session.CloseDatabase(DestDatabase);
