Советы по Delphi. Версия 1.4.3 от 1.1.2001

 procedure SetShowing(Value: Boolean);
 function CalcHintRect(Hint: string): TRect;
 procedure Appear;
 procedure Disappear;
public
 property Showing: Boolean read FShowing write SetShowing;
end;

implementation

function TFocusHintWindow.CalcHintRect(Hint: string): TRect;
var Buffer: array[Byte] of Char;
begin
 Result := Bounds(0, 0, Screen.Width, 0);
 DrawText(Canvas.Handle, StrPCopy(Buffer, Hint), -1, Result, DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
 with HintControl, ClientOrigin do OffsetRect(Result, X, Y + Height + 6);
 Inc(Result.Right, 6);
 Inc(Result.Bottom, 2);
end;

procedure TFocusHintWindow.Appear;
var
 Hint: string;
 HintRect: TRect;
begin
 if (Screen.ActiveControl = HintControl) then Exit;
 HintControl := Screen.ActiveControl;
 Hint := GetShortHint(HintControl.Hint);
 HintRect := CalcHintRect(Hint);
 ActivateHint(HintRect, Hint);
 FShowing := True;
end;

procedure TFocusHintWindow.Disappear;
begin
 HintControl := nil;
 ShowWindow(Handle, SW_HIDE);
 FShowing := False;
end;

procedure TFocusHintWindow.SetShowing(Value: Boolean);
begin
 if Value then Appear else Disappear;
end;
end.

– Ed Jordan

Вызов 16-разрядного кода из 32-разрядного

Andrew Pastushenko пишет:

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

{ GetFeeSystemResources routine for 32-bit Delphi.
 Works only under Windows 9x }
unit SysRes32;

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
function GetFeeSystemResources(SysResource: Word): Word;

implementation

uses SysUtils, 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
function LoadLibrary16(LibFileName: PAnsiChar): THandle; stdcall; external kernel32 index 35;
function FreeLibrary16(LibModule: THandle): THandle; stdcall; external kernel32 index 36;
function GetProcAddress16(Module: THandle; ProcName: LPCSTR): TFarProc;stdcall; external kernel32 index 37;
procedure QT_Thunk; cdecl; external 'kernel32.dll' name 'QT_Thunk';

{$StackFrames On}
function GetFeeSystemResources(SysResource: Word): Word;
var EatStackSpace: 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