Unit VCLUtils

*****************************************************} { } { Delphi VCL Extensions (RX) } { } { Copyright (c) 1995,96 AO ROSNO } { Copyright (c) 1997,98 Master-Bank } { } {

Classes

TScreenCanvas - TScreenCanvas

Functions

ActivatePrevInstance -
ActivateWindow -
AllocMemo - Memory routines

Memory routines
AnsiUpperFirstChar -
AssignBitmapCell -
Beep -
CenterControl -
CenterWindow -
ChangeBitmapColor - ChangeBitmapColor.
CheckWin32 -
CompareMem -
CopyParentImage -
CreateBitmapFromIcon - Create TBitmap object from TIcon
CreateDisabledBitmap - CreateDisabledBitmap.
CreateTwoColorsBrushPattern - Brush Pattern
DefineCursor - Unfortunately I don't know how we can load animated cursor from executable resource directly.
Delay - Delete the requested message from the queue, but throw back } { any WM_QUIT msgs that PeekMessage may also return.
DialogUnitsToPixelsX - Convert dialog units to pixels and backwards

Dialog units
DialogUnitsToPixelsY -
DrawBitmapRectTransparent -
DrawBitmapTransparent - Windows resources (bitmaps and icons) VCL-oriented routines
DrawCellBitmap -
DrawCellText - vaBottomJustify
DrawCellTextEx - brush origin tics in painting / scrolling.
DrawInvertFrame -
DrawTransparentBitmap -
DropT -
FindPrevInstance -
FreeMemo -
FreeUnusedOle -
GetAveCharSize -
GetEnvVar - String routines

String routines } {$W+
GetMemoSize -
GradientFillRect - Gradient fill procedure - displays a gradient beginning with a chosen } { color and ending with another chosen color.
HeightOf -
HMemCpy -
HugeDec -
HugeInc - Manipulate huge pointers routines

Manipulate huge pointers routines by Ray Lischner, The Waite Group, Inc.
HugeMove -
HugeOffset -
IsForegroundTask -
KillMessage -
LoadAniCursor - Cursor routines } {$IFDEF WIN32} {$IFNDEF RX_D3
LoadDLL - Service routines
MakeBitmap -
MakeBitmapID -
MakeIcon - Icons
MakeIconID -
MakeModuleBitmap - Bitmap
MakeModuleIcon -
MergeForm -
MinimizeText - case
MoveWindowOrg -
MsgBox - Standard Windows MessageBox function
MsgDlg -
NotImplemented - Service routines
PaintInverseRect -
PaletteColor -
PaletteEntries - allowing access to other controls, etc.
PixelsToDialogUnitsX -
PixelsToDialogUnitsY -
PointInPolyRgn -
PointInRect -
ReallocMemo -
RegisterServer -
ResourceNotFound - Exceptions
ResStr -
ShadeRect - Shade rectangle
ShowWinNoAnimate -
SplitCommandLine -
StartWait - Look for an unassigned cursor index
StopWait -
StretchBitmapRectTransparent -
StretchBltTransparent - Windows API level routines

Transparent bitmap
StringToPChar -
StrPAlloc -
SwitchToWindow -
WidthOf -
Win32Check - obsolete, use Win32Check } {$IFNDEF RX_D3

Win32Check is used to check the return value of a Win32 API function which returns a BOOL to indicate success.
WindowClassName -
WriteText -

Types

TCustomForm
TDate
TFillDirection
TTime
TVertAlignment
TWMMouseWheel

Constants

clCream
clMoneyGreen
clSkyBlue
mrNoToAll
mrYesToAll
WaitCursor

Variables


Functions


function ActivatePrevInstance(const MainFormClass, ATitle: string): Boolean;


procedure ActivateWindow(Wnd: HWnd);


function AllocMemo(Size: Longint): Pointer;

Memory routines

Memory routines


function AnsiUpperFirstChar(const S: string): string;


procedure AssignBitmapCell(Source: TGraphic; Dest: TBitmap; Cols, Rows, Index: Integer);


procedure Beep;


procedure CenterControl(Control: TControl);


procedure CenterWindow(Wnd: HWnd);


function ChangeBitmapColor(Bitmap: TBitmap; Color, NewColor: TColor): TBitmap;

ChangeBitmapColor. This function create new TBitmap object. You must destroy it outside by calling TBitmap.Free method.

function CheckWin32(OK: Boolean): Boolean;


function CompareMem(fpBlock1, fpBlock2: Pointer; Size: Cardinal): Boolean;


procedure CopyParentImage(Control: TControl; Dest: TCanvas);


function CreateBitmapFromIcon(Icon: TIcon; BackColor: TColor): TBitmap;

Create TBitmap object from TIcon

function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor): TBitmap;

CreateDisabledBitmap. Creating TBitmap object with disable button glyph image. You must destroy it outside by calling TBitmap.Free method.

function CreateTwoColorsBrushPattern(Color1, Color2: TColor): TBitmap;

Brush Pattern

function DefineCursor(Instance: THandle; ResID: PChar): TCursor;

Unfortunately I don't know how we can load animated cursor from executable resource directly. So I write this routine using temporary file and LoadCursorFromFile function.

procedure Delay(MSecs: Longint);

Delete the requested message from the queue, but throw back } { any WM_QUIT msgs that PeekMessage may also return. } { Copied from DbGrid.pas

function DialogUnitsToPixelsX(DlgUnits: Word): Word;

Convert dialog units to pixels and backwards

Dialog units


function DialogUnitsToPixelsY(DlgUnits: Word): Word;


procedure DrawBitmapRectTransparent(Dest: TCanvas; DstX, DstY: Integer; SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);


procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer; Bitmap: TBitmap; TransparentColor: TColor);

Windows resources (bitmaps and icons) VCL-oriented routines

procedure DrawCellBitmap(Control: TCustomControl; ACol, ARow: Longint; Bmp: TGraphic; Rect: TRect);


procedure DrawCellText(Control: TCustomControl; ACol, ARow: Longint; const S: string; const ARect: TRect; Align: TAlignment; VertAlign: TVertAlignment);

vaBottomJustify

procedure DrawCellTextEx(Control: TCustomControl; ACol, ARow: Longint; const S: string; const ARect: TRect; Align: TAlignment; VertAlign: TVertAlignment; WordWrap: Boolean);

brush origin tics in painting / scrolling.

procedure DrawInvertFrame(ScreenRect: TRect; Width: Integer);


procedure DrawTransparentBitmap(DC: HDC; Bitmap: HBitmap; DstX, DstY: Integer; TransparentColor: TColorRef);


function DropT(const S: string): string;


function FindPrevInstance(const MainFormClass, ATitle: string): HWnd;


procedure FreeMemo(var fpBlock: Pointer);


procedure FreeUnusedOle;


function GetAveCharSize(Canvas: TCanvas): TPoint;


function GetEnvVar(const VarName: string): string;

String routines

String routines } {$W+


function GetMemoSize(fpBlock: Pointer): Longint;


procedure GradientFillRect(Canvas: TCanvas; Rect: TRect; BeginColor, EndColor: TColor; Direction: TFillDirection; Colors: Byte);

Gradient fill procedure - displays a gradient beginning with a chosen } { color and ending with another chosen color. Based on TGradientFill } { component source code written by Curtis White, cwhite@teleport.com.

function HeightOf(R: TRect): Integer;


procedure HMemCpy(DstPtr, SrcPtr: Pointer; Amount: Longint);


procedure HugeDec(var HugePtr: Pointer; Amount: Longint);


procedure HugeInc(var HugePtr: Pointer; Amount: Longint);

Manipulate huge pointers routines

Manipulate huge pointers routines by Ray Lischner, The Waite Group, Inc. } {$IFDEF WIN32


procedure HugeMove(Base: Pointer; Dst, Src, Size: Longint);


function HugeOffset(HugePtr: Pointer; Amount: Longint): Pointer;


function IsForegroundTask: Boolean;


procedure KillMessage(Wnd: HWnd; Msg: Cardinal);


function LoadAniCursor(Instance: THandle; ResID: PChar): HCursor;

Cursor routines } {$IFDEF WIN32} {$IFNDEF RX_D3

function LoadDLL(const LibName: string): THandle;

Service routines

function MakeBitmap(ResID: PChar): TBitmap;


function MakeBitmapID(ResID: Word): TBitmap;


function MakeIcon(ResID: PChar): TIcon;

Icons

function MakeIconID(ResID: Word): TIcon;


function MakeModuleBitmap(Module: THandle; ResID: PChar): TBitmap;

Bitmap

function MakeModuleIcon(Module: THandle; ResID: PChar): TIcon;


procedure MergeForm(AControl: TWinControl; AForm: TForm; Align: TAlign; Show: Boolean);


function MinimizeText(const Text: string; Canvas: TCanvas; MaxWidth: Integer): string;

case

procedure MoveWindowOrg(DC: HDC; DX, DY: Integer);


function MsgBox(const Caption, Text: string; Flags: Integer): Integer;

Standard Windows MessageBox function

function MsgDlg(const Msg: string; AType: TMsgDlgType; AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;


procedure NotImplemented;

Service routines

procedure PaintInverseRect(RectOrg, RectEnd: TPoint);


function PaletteColor(Color: TColor): Longint;


function PaletteEntries(Palette: HPALETTE): Integer;

allowing access to other controls, etc.

function PixelsToDialogUnitsX(PixUnits: Word): Word;


function PixelsToDialogUnitsY(PixUnits: Word): Word;


function PointInPolyRgn(const P: TPoint; const Points: array of TPoint): Boolean;


function PointInRect(const P: TPoint; const R: TRect): Boolean;


function ReallocMemo(fpBlock: Pointer; Size: Longint): Pointer;


function RegisterServer(const ModuleName: string): Boolean;


procedure ResourceNotFound(ResID: PChar);

Exceptions

function ResStr(Ident: Cardinal): string;


procedure ShadeRect(DC: HDC; const Rect: TRect);

Shade rectangle

procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);


procedure SplitCommandLine(const CmdLine: string; var ExeName, Params: string);


procedure StartWait;

Look for an unassigned cursor index

procedure StopWait;


procedure StretchBitmapRectTransparent(Dest: TCanvas; DstX, DstY, DstW, DstH: Integer; SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);


procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer; SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; Palette: HPalette; TransparentColor: TColorRef);

Windows API level routines

Transparent bitmap


function StringToPChar(var S: string): PChar;


function StrPAlloc(const S: string): PChar;


procedure SwitchToWindow(Wnd: HWnd; Restore: Boolean);


function WidthOf(R: TRect): Integer;


function Win32Check(RetVal: Bool): Bool;

obsolete, use Win32Check } {$IFNDEF RX_D3

Win32Check is used to check the return value of a Win32 API function which returns a BOOL to indicate success. } {$IFDEF WIN32} {$IFNDEF RX_D3


function WindowClassName(Wnd: HWnd): string;


procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment; WordWrap: Boolean);


Types


TCustomForm = TForm
for Delphi 3.0 and previous versions compatibility
TDate = TDateTime

TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft);
Gradient filling routine
TTime = TDateTime

TVertAlignment = (vaTopJustify, vaCenter, vaBottomJustify);
Grid drawing
TWMMouseWheel = record
Msg : Cardinal;
Keys : Word;
Delta : Word;
end;
Mouse Wheel message } {$IFDEF WIN32

Constants

clCream = TColor($A6CAF0)

Standard Windows colors that are not defined by Delphi

clMoneyGreen = TColor($C0DCC0)

clSkyBlue = TColor($FFFBF0)

mrNoToAll = mrAll + 1

ModalResult constants } {$IFNDEF RX_D3

mrYesToAll = mrNoToAll + 1

WaitCursor = crHourGlass

Cursor routines

Variables