Unit Calmuniv

*******************************************************} { } { Calmira Visual Component Library 1.0 } { by Li-Hsin Huang, } { released into the public domain January 1997 } { } {---------------------------------------------------------} { all the singe Vcl unit are moved in one big vcl unit } { by Bauer Karl e-mail: karbauer@mail.teleconsult.de } {---------------------------------------------------------} { If it breaks your data, PC, reputation } {or anything else you have my condolences. But you don't } {get a guarantee, so I can't acceept any responsibility...} {*********************************************************} { TCalAppHolder component } { TCalAppHolder is a simple container component that provides design-time access to TApplication's properties and events. When the component is loaded, it assigns its data to TApplication. You can use it to automatically create event handlers for TApplication and TScreen just like events for visual controls -- just double click on the event. In addition, there is the OnWndProc event which is, in effect, a fast way to subclass the application's main window without going down to the API level. If you create an OnWndProc event, this is triggered each time the application's WndProc is called, and you can process messages that never generate an OnMessage event because they are sent directly to the window procedure. For this event, return False to allow TApplication to continue processing the message, and True to stop TApplication handling it further. It is especially useful to trap WM_ENDSESSION here so that your program can save its layout etc. before Windows shuts down. { TCalCheckList control } { TCalCheckList is a listbox that acts as an array of checkboxes. It draws each item like a 3D check box, using the Selected property to determine if an item is checked. At design time, use the Items property to set the contents. This has many advantages over a large array or group of standard TCheckbox controls: 1. Less resources -- a listbox only uses one window handle. 2. Fast -- only one control is created and drawn. 3. Practically unlimited capacity, without using more resources. 4. Scrollable -- pack a large number of options into a small space in a dialog box. The check list was originally designed so that many Boolean variables can be set without the need to map each var to one TCheckbox, which is error prone and slow, so there are two additional methods to allow efficient data transfer. SetData - accepts an open array of Booleans which is used to set the Selected property. GetData - accepts an open array of Boolean pointers, which is assigned the values from the Selected property. RangeCheck - if True, a call to GetData or SetData will check that the size of the open array matches the size of the list. This often catches out ommissions and inconsistencies. For long lists, you can use just paste a copy the SetData call, change the "Set" to a "Get" and add @ symbols in front of each boolean identifier. Example : var DebugInfo, LocalSymbols, SymbolInfo : Boolean; CheckList1.SetData([DebugInfo, LocalSymbols, SymbolInfo]); if ShowModal = mrOK then CheckList1.GetData([@DebugInfo, @LocalSymbols, @SymbolInfo]); Don't forget to distribute CHKLIST.RES, which contains the fake checkbox bitmaps. { TCalMultiGrid component Properties Selected - determines if a given cell is highlighted SelCount - determines how many cells are highlighted in the grid Multi - true if the grid is in "multi-select" mode AllowMulti - enables or disables multiple selections Limit - the valid range for the grid. Cells with an index outside of Limit will not be painted and cannot be selected with the mouse. Focus - determines which cell has the dotted box draw around it ThumbTrack - controls the goThumbTracking element of TCustomGrid (the inherited Options property is not made public) DropFocus - determines which cell has a focus rect drawn around it during drag and drop. Set to -1 to hide the drop focus. Methods SelectAll and DeselectAll - highlights and unhighlights all cells in the grid, up to Limit CellIndex - returns the linear index of a given row and column Reset - deselects all cells without generating events and redraws the control Use this to initialize between different phases of use. Select - moves the focus to the given cell and selects it MouseToCell - returns the index of the cell at the given pixel position SetSize - changes the number of columns and rows while preserving the current selection. If you modify the ColCount and RowCount properties directly, all selections are lost. SizeGrid - automatically adjusts the number of columns and rows to fit the current grid size Events OnSelectCell - occurs just before a cell is selected (like TDrawGrid's OnSelectCell event). You have the chance to cancel this operation. OnSelect - occurs after the user has selected a cell by left clicking with the mouse (or moving the cursor keys). Typically you would use this event to respond to a single or multiple selection. This event occurs only once for each mouse click. OnCellSelected - occurs after the highlight of a cell is turned on or off, either by the user or by the program assigning a value to the Selected property. If the user selects a range of cells by using the Shift key, this event occurs once for every cell that has its highlight changed. OnDrawCell - same as OnDrawCell for a TDrawGrid except that an integer cell index is used { TCalDropClient component Allows Delphi programs to accept file drops from File Manager. Another ubiquitous component, but I couldn't find a freeware one with source code so I wrote my own. Since I already had a handler for Application.OnMessage, I decided against low level subclassing. Consequently, you'll need to call TCalDropClient.CheckMessage inside the OnMessage handler. Files : TStrings; (inherited, run-time only) Contains a list of dropped files after another program has dropped them. This list is cleared before each drop if the AutoClear property is True. AutoClear : Boolean (inherited) Determines whether to clear the Files list before a drop. Handle : HWND (read and run-time only) The window handle of the owning windowed control DropPos : TPoint (read and run-time only) The coordinates of the last drop, in the coordinate system of the owning windowed control (usually a TForm) OnDropFiles When this event occurs, the Files property contains a list of dropped files and DropPos contains the coordinates of the cursor when the drop occured. CheckMessage(var Msg : TMsg; var Handled : Boolean); You need to call this message in the application's OnMessage handler. It checks an application message record to see if it is a file drop message. If so, the corresponding DropClient component is activated to trigger the OnDropFiles event which you can handle. Handled is set to True if the message has been processed. { TDragDrop component } { TDragDrop is an abstract base class for TCalDropServer and TCalDropClient. It defines the Files and AutoClear properties. To add more funtionality to both TCalDropServer or TCalDropClient (e.g., methods to process filenames), write the code for TDragDrop instead. { TCalDropServer component If you ever need to drop files into other programs, this component can lend a hand, although it still requires some programming on your part. In a control's OnMouseMove handler, call CanDrop to determine if if the cursor is over a suitable window. In the OnEndDrag handler, call the DragFinished method. If a drop is allowed, the OnFileDrop event is triggered which lets you assign the files to drop. AutoClear : Boolean (inherited) If this is True, then the Files property is cleared after each drop is completed. Files : TStrings (run-time only) Contains a list of files to drop into another program InternalDrop : Boolean If this is set to True, OnFileDrag events will occur when the cursor is over a valid window belonging to your program. If it is False, OnFileDrag only occurs when the cursor is over another program. Generally, you should use Delphi's own drag and drop handling and set this to False. DesktopDrop : Boolean If this is set to True, you will receive an OnDesktopDrop event when the mouse is released over the desktop background or wallpaper. CanDrop: Boolean; Returns True if the cursor is over something that can accept drops. Call this inside an OnMouseMove handler. If the cursor is currently over a window, the call will trigger the OnFileDrag event to ask you for confirmation of the drop. procedure DragFinished; Call this inside an OnEndDrag handler. If the cursor is over a suitable window and you have responded to the OnFileDrag event, then an OnFileDrop is triggered to let you assign the filenames. procedure DropFiles(Wnd: HWnd; AMousePos: TPoint); Encapsulates the WM_DROPFILES message and immediately causes a drop into the given window. The strings in the Files property are contatenated into the required structure and a WM_DROPFILES message is sent to the given window. The TPoint parameter lets you control the location of this forced drop. OnFileDrag Occurs when you call CanDrop and the cursor is over a window that accepts dropped files. To permit the drop (if the user releases the mouse button), set the Accept property to True. The Target parameter contains the handle of the window in question, and lets you perform your own tests before accepting. OnFileDrop Occurs when the user releases the mouse button over a window that accepts files and you call DragFinished method. During this event, you must fill the Files property with the files you wish to drop (one file per line). The drop takes place as soon as your handler finishes executing. OnDesktopDrop Occurs when the user releases the mouse button over the desktop. This is only a notification - TCalDropServer doesn't do anything afterwards. The Target parameter contains the window handle of the desktop, in case you want to send any messages to it. { TCalSystemMenu provides a thin wrapper for the Windows API menu functions, and is used to change a form's system menu. It's most useful in the OnCreate handler, when you can modify the menu before the form appears. Mainly, it saves you having to remember (or look up) the multitude of parameters. } { TCalFormDrag component } { TCalFormDrag lets the user move and resize a form with a non-resizable border, typically bsSingle. It can simulate a "solid" drag like Windows95, or for slower machines, it can use hollow boxes instead. Just drop the component onto your form, and it is ready to use. Windows 3.x is generally not up to dynamically resizing the controls during dragging, so TCalFormDrag hides all the controls and shows them when the dragging has stopped. Note that you should not re-assign the following event handlers of TForm at run-time: OnMouseMove, OnMouseDown, OnMouseUp, OnPaint and OnResize. TCalFormDrag prevents some of these events from occuring when it takes over the dragging, so that you need not be concerned with any side effects -- just pretend the component is not there and program normally. DragWidth The size of the square in the bottom right corner reserved for resizing the form. Hollow Determines if the form is resized during dragging, or a hollow rectangle used to represent the form's dimensions. MinWidth, MinHeight, MaxWidth, MaxHeight Constrains the size of the form AllowMove, AllowSize Enables the two operations of this component DragState (run-time and read only) Indicates what kind of dragging is taking place. Check this to avoid executing code that could disrupt the operation. { Some useful Delphi and Windows routines

Classes

TCalAppHolder -
TCalBarGauge -
TCalCheckList -
TCalDropClient -
TCalDropServer -
TCalFormDrag -
TCalIconDialog -
TCalMultiGrid -
TCalStyleSpeed -
TCalSystemMenu -
TDragDrop -
TIconSelForm -
TUniqueStrings -

Functions

AddHistory - Updates the cursor image when you have changed the Cursor or DragCursor property of a control
AttrToStr - Modifies a string so that it can be used as a PChar without additional
Blank - Returns the number of occurences of c in S
Border3d - Returns 1 if x > 0, -1 if x < 0 and 0 if x = 0
CharCount - Returns true if a character is present in a string.
ErrorMsg - Draws a raised 3D border on a canvas, typically used in an OnPaint method of a TForm
ExtractFileDir - Removes a trailing backslash from a directory name, if necessary
FileParams - The opposite of Format, Unformat splits up a formatted source string into substrings and Integers.
FillString - If s contains an '=', the portion to the right of '=' is set to the value
FormatByte - Calls MakeDirname after calling ExtractFilePath
GetMenuCheck -
GetRadioIndex - Returns a value from the Windows registration database, with the specified key from HKEY_CLASSES_ROOT
GetRegValue - Converts a DOS timestamp to TDateTime.
GetStrKey - Formats a number (assumed to be bytes) to display as bytes, KB or MB, for example "245 bytes", "1.
GetStrValue -
GetWord - Assumes that the strings parameter contains a list of filename, and concatenates the names to form a single string suitable for passing as a command line parameter.
InitBitmap - A very simple way of displaying a dynamic modal form -- just pass the form's class name e.
InString - converts a character to lower case
Intersects - Plays the specified WAV file as a sound effect.
LowCase -
LTrim -
MakeDirname - Adds a trailing backslash to a directory name, if necessary
MakePath - Returns true if the string is empty or consists of spaces
Max -
Min - Set the new coordinates of the form and clean up the graphics stuff
MsgDialog - Adds a combo box's Text string to its listbox, but only if the string is not empty and not already present in the list.
NormalizeRect - Returns True if the two rectangles intersect
PlaySound - Displays a message dialog box indicating an error
Range - Returns the smaller and larger of two values respectively
RefreshCursor - These routines are useful for setting and querying the state of several controls.
Register - ------------------------------------------------------------------------------------
RTrim -
SetMenuCheck -
SetRadioIndex -
SetStrValue - Returns the left and right sides, respectively, of a string with the structure Key=Value
ShowModalDialog - Calls the MessageDialog function, but also plays a suitable sound effect from the Control Panel settings.
ShrinkIcon - Initialises the bitmap's dimensions and fills it with the chosen colour

initializes a bitmap with width, height and background colour
Sign - Constrains n to a lower and upper limit
StringAsPChar - Skips spaces and returns the next word in a string.
TimeStampToDate - Returns a rectangle defined by any two points.
Trim -
Unformat - Returns a string of length n containing only the specified character

if size < 1024 then if size = 1 then Result := '1 byte' else Result := IntToStr(size) + ' bytes' else if size < 1048576 then Result := FloatToStrF(size / 1024, ffNumber, 7, 2) + 'KB' else Result := FloatToStrF(size / 1048576, ffNumber, 7, 2) + 'MB';

Types

PBoolean
PBooleanList
TAttrStr
TBarKind
TBooleanList
TCalFormDragState
TCellSelectedEvent
TFileDragEvent
TFileDropEvent
TGridSelectEvent
TMultiDrawCellEvent
TMultiSelectCellEvent
TSpeedStyle

Constants

AlphaDigits
Alphas
Digits
Lowers
MsgDialogSounds
OneItem
Uppers

Variables

ApplicationPath
IconSelForm
WinPath


Functions


function AddHistory(Combo : TComboBox): Boolean;

Updates the cursor image when you have changed the Cursor or DragCursor property of a control

function AttrToStr(attr : Integer): TAttrStr;

Modifies a string so that it can be used as a PChar without additional

function Blank(const s: string): boolean;

Returns the number of occurences of c in S

procedure Border3d(Canvas : TCanvas; Width, Height: Integer);

Returns 1 if x > 0, -1 if x < 0 and 0 if x = 0

function CharCount(c: Char; const S: string): Integer;

Returns true if a character is present in a string. Probably faster than Pos.

procedure ErrorMsg(const msg: string);

Draws a raised 3D border on a canvas, typically used in an OnPaint method of a TForm

function ExtractFileDir(const s: string): string;

Removes a trailing backslash from a directory name, if necessary

function FileParams(files: TStrings): string;

The opposite of Format, Unformat splits up a formatted source string into substrings and Integers. It is an alternative to parsing when the format is known to be fixed. The pattern parameter contains the format string, which is a combination of plain characters and format specifiers. The following specifiers are supported: %s indicates that a string value is required %d indicates that an integer value is required %S indicates that a string value should be ignored %D indicates that an integer value should be ignored Unformat compares the source with the pattern, and plain characters that do not match will raise an EConvertError. When a format specifier is encountered in the pattern, an argument is fetched and used to store the result that is obtained from the source. Then the comparison continues. For each %s, the args list must contain a pointer to a string variable, followed by an integer specifying the maximum length of the string. For each %d, the args list must contain a pointer to an integer variable. When the end of the source string is reached, the function returns without modifying the remaining arguments, so you might wish to initialize your variables to "default" values before the function call. Unformat returns the number of values it has extracted. Examples: var s1, s2: string[31]; i : Integer; Unformat('[abc]123(def)', '[%s]%d(%s)', [@s1, 31, @i, @s2, 31]); (* s1 = 'abc', i = 123, s2 = 'def' *) Unformat('Hello, Universe!!!', '%s, %s%d', [@s1, 31, @s2, 31, @i]); (* s1 = 'Hello', s2 = 'Universe!!!', i is untouched *) Unformat('How much wood could a woodchuck chuck...', '%S %S %s could a %S %s...', [@s1, 31, @s2, 31]); (* s1 = 'wood', s2 = 'chuck' *)

function FillString(c: char; n: Byte): string;

If s contains an '=', the portion to the right of '=' is set to the value

function FormatByte(size : Longint): string;

Calls MakeDirname after calling ExtractFilePath

function GetMenuCheck(const M: array of TMenuItem): Integer;


function GetRadioIndex(const R: array of TRadioButton): Integer;

Returns a value from the Windows registration database, with the specified key from HKEY_CLASSES_ROOT

function GetRegValue(key : string): string;

Converts a DOS timestamp to TDateTime. If the timestamp is invalid (some programs use invalid stamps as markers), the current date is returned instead of raising EConvertError

function GetStrKey(const s: string): string;

Formats a number (assumed to be bytes) to display as bytes, KB or MB, for example "245 bytes", "1.60KB", "44.10MB"

function GetStrValue(const s: string): string;


function GetWord(var s: OpenString): string;

Assumes that the strings parameter contains a list of filename, and concatenates the names to form a single string suitable for passing as a command line parameter. Filenames with no extension have an extra '.' appended to ensure correct interpretation

function InitBitmap(ABitmap: TBitmap; AWidth, AHeight : Integer; Color : TColor) : TBitmap;

A very simple way of displaying a dynamic modal form -- just pass the form's class name e.g. TForm1, and an instance will be created, shown as a modal dialog and then destroyed.

function InString(c: char; const s: string) : Boolean;

converts a character to lower case

function Intersects(const R, S: TRect): Boolean;

Plays the specified WAV file as a sound effect. If the filename is , nothing is played

function LowCase(c : Char) : Char;


function LTrim(const s: string): string;


function MakeDirname(const s: string): string;

Adds a trailing backslash to a directory name, if necessary

function MakePath(const s: string): string;

Returns true if the string is empty or consists of spaces

function Max(a, b: Integer): Integer;


function Min(a, b: Integer): Integer;

Set the new coordinates of the form and clean up the graphics stuff

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

Adds a combo box's Text string to its listbox, but only if the string is not empty and not already present in the list. The item is inserted at the top of the list, and if there are more than 24 items, the bottom one is removed. Returns true if the list is modified

function NormalizeRect(p, q: TPoint): TRect;

Returns True if the two rectangles intersect

procedure PlaySound(const filename: TFilename);

Displays a message dialog box indicating an error

function Range(n, lower, upper: Integer): Integer;

Returns the smaller and larger of two values respectively

procedure RefreshCursor;

These routines are useful for setting and querying the state of several controls. Use them to simulate arrays and as an alternative to TRadioGroup.

procedure Register;

------------------------------------------------------------------------------------

function RTrim(const s: string): string;


procedure SetMenuCheck(const M: array of TMenuItem; index: Integer);


procedure SetRadioIndex(const R: array of TRadioBUtton; index: Integer);


function SetStrValue(const s, value: string): string;

Returns the left and right sides, respectively, of a string with the structure Key=Value

function ShowModalDialog(FormClass : TFormClass): TModalResult;

Calls the MessageDialog function, but also plays a suitable sound effect from the Control Panel settings. The MsgDialogSounds variable enables the sounds

procedure ShrinkIcon(H : HIcon; Glyph : TBitmap);

Initialises the bitmap's dimensions and fills it with the chosen colour

initializes a bitmap with width, height and background colour


function Sign(x: Integer) : Integer;

Constrains n to a lower and upper limit

function StringAsPChar(var s: OpenString): PChar;

Skips spaces and returns the next word in a string. The word is deleted from the string

function TimeStampToDate(FileDate: Longint): TDateTime;

Returns a rectangle defined by any two points. When dragging a selection box with a mouse, the fixed corner and the moving corner may not always be top left and bottom right respectively. This function creates a valid TRect out of them

function Trim(const s: string): string;


function Unformat(const source, pattern: string; const args: array of const): Integer;

Returns a string of length n containing only the specified character

if size < 1024 then if size = 1 then Result := '1 byte' else Result := IntToStr(size) + ' bytes' else if size < 1048576 then Result := FloatToStrF(size / 1024, ffNumber, 7, 2) + 'KB' else Result := FloatToStrF(size / 1048576, ffNumber, 7, 2) + 'MB';


Types


PBoolean = ^Boolean

PBooleanList = ^TBooleanList

TAttrStr = string[5]

TBarKind = (bkHorizontal, bkVertical);

TBooleanList = array[0..65528] of Boolean;

TCalFormDragState = (fdNone, fdSolidMove, fdSolidSize, fdHollowMove, fdHollowSize);
Published declarations
TCellSelectedEvent = procedure (Sender : TObject; Index : Integer;
     IsSelected : Boolean) of object

TFileDragEvent = procedure (Sender : TObject; X, Y: Integer;
    Target : HWND; var Accept : Boolean) of object

TFileDropEvent = procedure (Sender : TObject; X, Y: Integer;
    Target : HWND) of object

TGridSelectEvent = procedure (Sender : TObject; Index : Integer) of object

TMultiDrawCellEvent = procedure (Sender : TObject; Index: Integer; Rect : TRect;
     State : TGridDrawState) of object

TMultiSelectCellEvent = procedure (Sender : TObject; Index: Integer;
     var CanSelect: Boolean) of object

TSpeedStyle = (sbSpeed, sbBitBtn, sbWin95);

Constants

AlphaDigits = Alphas + Digits

Alphas = Uppers + Lowers

Digits = ['0'..'9']

Lowers = ['a'..'z']

MsgDialogSounds = False

OneItem = ('s', '')

Uppers = ['A'..'Z']

Shrinks a 32 x 32 icon down to a 16 x 16 bitmap

Variables

ApplicationPath : TFilename

IconSelForm : TIconSelForm

WinPath : TFilename