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

LinkFile.Save(PWChar(WideString(path)),true);

finally

ShellObject:=Unassigned;

CoUninitialize;

end;

end;

На TabbedNotebook у меня есть множество компонентов TEdit. Я изменяю цвет компонентов TEdit на желтый и назначаю свойству Hint компонента строчку предупреждения, если поле редактирования содержит неверные данные.

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

Я не знаю как изменить поведение всплывающей подсказки, заданное по умолчанию. Я знаю что это возможно, но кто мне подскажет как?

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

FocusHintWindow.Showing := True;

FocusHintWindow.Showing := False;

Пример того, как это можно использовать, содержится в комментариях к модулю. Это просто.

unitFHintWin;

{ -----------------------------------------------------------

TFocusHintWindow --

Вот пример того, как можно использовать TFocusHintWindow.

Данный пример выводит всплывающую подсказку ниже любого

TEdit, имеющего фокус. В противном случае выводится

стандартная подсказка Windows.

unit Unit1;

interface

uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FHintWin;

type TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

FocusHintWindow: TFocusHintWindow;

procedure AppIdle(Sender: TObject; var Done: Boolean);

procedure AppShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);

end;

implementation

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnIdle := AppIdle;

Application.OnShowHint := AppShowHint;

FocusHintWindow := TFocusHintWindow.Create(Self);

end;

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);

begin

FocusHintWindow.Showing := Screen.ActiveControl is TEdit;

end;

procedure TForm1.AppShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);

begin

CanShow := not FocusHintWindow.Showing;

end;

end.

----------------------------------------------------------- }

interface

usesSysUtils, WinTypes, WinProcs, Classes, Controls, Forms;

typeTFocusHintWindow = class(THintWindow)

private

FShowing: Boolean;

HintControl: TControl;

protected

procedureSetShowing(Value: Boolean);

functionCalcHintRect(Hint: string): TRect;

procedureAppear;

procedureDisappear;

public

propertyShowing: Boolean readFShowing writeSetShowing;

end;

implementation

functionTFocusHintWindow.CalcHintRect(Hint: string): TRect;

varBuffer: array[Byte] ofChar;

begin

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

DrawText(Canvas.Handle, StrPCopy(Buffer, Hint), -1, Result, DT_CALCRECT orDT_LEFT orDT_WORDBREAK orDT_NOPREFIX);

withHintControl, ClientOrigin doOffsetRect(Result, X, Y + Height + 6);

Inc(Result.Right, 6);

Inc(Result.Bottom, 2);

end;

procedureTFocusHintWindow.Appear;

var

Hint: string;

HintRect: TRect;

begin

if(Screen.ActiveControl = HintControl) thenExit;

HintControl := Screen.ActiveControl;

Hint := GetShortHint(HintControl.Hint);

HintRect := CalcHintRect(Hint);

ActivateHint(HintRect, Hint);

FShowing := True;

end;

procedureTFocusHintWindow.Disappear;

begin

HintControl := nil;

ShowWindow(Handle, SW_HIDE);

FShowing := False;

end;

procedureTFocusHintWindow.SetShowing(Value: Boolean);

begin

ifValue thenAppear elseDisappear;

end;

end.

– Ed Jordan

Andrew Pastushenkoпишет:

Посылаю код для определения системных ресурсов (как в "Индикаторе ресурсов"). Использовалась статья "Calling 16-bit code from 32-bit in Windows 95".

{ GetFeeSystemResources routine for 32-bit Delphi.

Works only under Windows 9x }

unitSysRes32;

interface

const

//Constants whitch specifies the type of resource to be checked

GFSR_SYSTEMRESOURCES = $0000;

GFSR_GDIRESOURCES = $0001;

GFSR_USERRESOURCES = $0002;

// 32-bit function exported from this unit

functionGetFeeSystemResources(SysResource: Word): Word;

implementation

usesSysUtils, Windows;

type

//Procedural variable for testing for a nil

TGetFSR = function(ResType: Word): Word; stdcall;

//Declare our class exeptions

EThunkError = class(Exception);

EFOpenError = class(Exception);

var

User16Handle : THandle = 0;

GetFSR : TGetFSR = nil;

//Prototypes for some undocumented API

functionLoadLibrary16(LibFileName: PAnsiChar): THandle; stdcall; externalkernel32 index35;

functionFreeLibrary16(LibModule: THandle): THandle; stdcall; externalkernel32 index36;

functionGetProcAddress16(Module: THandle; ProcName: LPCSTR): TFarProc; stdcall; externalkernel32 index37;

procedureQT_Thunk; cdecl; external'kernel32.dll' name'QT_Thunk';

{$StackFrames On}

functionGetFeeSystemResources(SysResource: Word): Word;

varEatStackSpace: String[$3C];

begin

// Ensure buffer isn't optimised away

EatStackSpace := '';

@GetFSR:=GetProcAddress16(User16Handle, 'GETFREESYSTEMRESOURCES');

if Assigned(GetFSR) then //Test result for nil

asm

//Manually push onto the stack type of resource to be checked first

push SysResource

//Load routine address into EDX

mov edx, [GetFSR]

//Call routine

call QT_Thunk

//Assign result to the function

mov @Result, ax

end

else raiseEFOpenError.Create('GetProcAddress16 failed!');

end;

initialization

//Check Platform for Windows 9x

ifWin32Platform <> VER_PLATFORM_WIN32_WINDOWS then raiseEThunkError.Create('Flat thunks only supported under Windows 9x');

//Load 16-bit DLL (USER.EXE)

User16Handle:= LoadLibrary16(PChar('User.exe'));

ifUser16Handle < 32 then raiseEFOpenError.Create('LoadLibrary16 failed!');

finalization

//Release 16-bit DLL when done

ifUser16Handle <> 0 thenFreeLibrary16(User16Handle);

end.

Nomadicпишет:

// Routine: check if the user has administrator provileges

// Was converted from C source by Akzhan Abdulin. Not properly tested.

typePTOKEN_GROUPS = TOKEN_GROUPS^;

functionRunningAsAdministrator(): Boolean;

var

SystemSidAuthority: SID_IDENTIFIER_AUTHORITY = SECURITY_NT_AUTHORITY;