How to draw a rotated ellipse at a specific angle (2)

Problem/Question/Abstract:

I created an object based off of TGraphicControl and I used the TCanvas.Ellipse method to create an ellipse. I would like to give the user the ability to rotate this ellipse. I would also like to give the user the ability after rotating the ellipse to still adjust the size and shape.

Answer:

You can use Win32GDI Routines. It works like this:


procedure RotatedEllipse(aCanvas: TCanvas; X1, Y1, X2, Y2: Integer);
var
  T, O: TXForm; {in unit Windows}
begin
  { ... }
  SetGraphicsMode(aCanvas.Handle, GM_Advanced);
  GetWorldTransform(aCanvas.Handle, O);
  {Angle in degree}
  T.eM11 := 1 * Cos(w / 360 * Pi * 2);
  T.eM22 := 1 * Cos(w / 360 * Pi * 2);
  T.eM12 := 1 * Sin(w / 360 * Pi * 2);
  T.eM21 := 1 * -Sin(w / 360 * Pi * 2);
  T.eDX := Round((X1 + X2) / 2);
  T.eDY := Round((Y1 + Y2) / 2);
  ModifyWorldTransform(aCanvas.Handle, T, MWT_LEFTMULTIPLY);
  Canvas.Ellipse(X1, Y1, X2, Y2);
  SetWorldTransform(TheDraw.Handle, O);
end;

Define variables in a Word document and set their values programmatically

Problem/Question/Abstract:

I need to define some variables in a Word document and be able to set their values from my Delphi program. How can I do that?

Answer:

You can do that using custom document properties:

uses
  Office97; {or Office2000, OfficeXP, Office_TLB}

var
  VDoc, PropName, DocName: OleVariant;
  VDoc := Word.ActiveDocument;
  { ... }

{ Set a document property }
PropName := 'MyOpinionOfThisDocument';
VDoc.CustomDocumentProperties.Add(PropName, False, msoPropertyTypeString,
  'Utter drivel', EmptyParam);
{ Read a document property }
Caption := VDoc.CustomDocumentProperties[PropName].Value;
{ ... }

Faster recordcount for sqlserver clientserver applications

Problem/Question/Abstract:

When using the standard dataset.recordcount in my client-server (win nt against sqlserver7 db, targettable has 500.000 records) i can go for lunch and stil be waiting (:-

Answer:

For those of you who don't know why u should not use the standard dataset.recordcount when developing client server database applications.
This article is especialy for those cs db apps against a sqlserver 7 db.

since the standard dataset.recordcount iterates from begin of the table through the end of the table to result in the recordcount. This is a crime when developing cs db apps (against sqlserver7).

simply use another way of obtaining the number of records. I use a sql for obtaining the number of records in a sqlserver table.

drop a tquery on the form

provide this tquery with the follow SQL:

SQL:

select distinct max(itbl.rows)
from sysindexes as itbl
inner join sysobjects as otbl on (itbl.id = otbl.id)
where (otbl.type = 'U') and (otbl.name = :parTableName)

notice the parameter: parTableName type string

use this tquery to find out how many rows in the table

TIP: try to make your own tYourSqlServerCountQuery and thus override the recordcount property.
ByTheWay: use this only for sqlserver

for other cs db apps simply use a count sql (coming upnext time...)

Set system date and time

Problem/Question/Abstract:

Set system date and time

Answer:

With the procedure SetDateTime you can set the date and time of the operating system, from within your Delphi application.

In the interface-section you define the procedure:

procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);

In the 'implementation' you write...:

{ SetDateTime sets the date and time of the operating system }

procedure SetDateTime(Year, Month, Day, Hour, Minu, Sec, MSec: Word);
var
  NewDateTime: TSystemTime;
begin
  FillChar(NewDateTime, sizeof(NewDateTime), #0);
  NewDateTime.wYear := Year;
  NewDateTime.wMonth := Month;
  NewDateTime.wDay := Day;
  NewDateTime.wHour := Hour;
  NewDateTime.wMinute := Minu;
  NewDateTime.wSecond := Sec;
  NewDateTime.wMilliseconds := MSec;
  SetLocalTime(NewDateTime);
end;

Determining the associated application

Problem/Question/Abstract:

How can I get the application associated with a document?

Answer:

Where is that information?

The applications associated with the file extensions are stored in the Windows Registry. To get this information first we should retrieve the "class" that a file extensions belongs to. This information can be found at:

  HKEY_CLASSES_ROOT\.ext\(default)

where ".ext" is the file extension you want (like ".txt", ".bmp", etc.). Then we get the command line used to open that kind of files. To do that, we retrieve the data under

  HKEY_CLASSES_ROOT\class\Shell\Open\Command\(default)

where "class" is the file class an extension belongs to. That string usually has the form

  "D:\PATH\APPNAME.EXT" "%1" -OPTIONS

where %1 is a placeholder for the document file to open with the application, so we should find its position within the string and replace it with the filename we want to open.

Example

The following function returns the command line of the associated application to open a documente file:

function GetAssociation(const DocFileName: string): string;
var
  FileClass: string;
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create(KEY_EXECUTE);
  Reg.RootKey := HKEY_CLASSES_ROOT;
  FileClass := '';
  if Reg.OpenKeyReadOnly(ExtractFileExt(DocFileName)) then
  begin
    FileClass := Reg.ReadString('');
    Reg.CloseKey;
  end;
  if FileClass <> '' then
  begin
    if Reg.OpenKeyReadOnly(FileClass + '\Shell\Open\Command') then
    begin
      Result := Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.Free;
end;

Copyright (c) 2001 Ernesto De Spirito
Visit: http://www.latiumsoftware.com/delphi-newsletter.php

Clear all edit controls on your form

Problem/Question/Abstract:

Clear all edit controls on your form

Answer:

The shortest way to do this:

procedure TForm1.ClearAll;
var
  i: integer;
begin
  for i := 0 to ComponentCount - 1 do
    if (Components[i] is TEdit) then
      (Components[i] as TEdit).Text := '';
end;

BDE alias info

Problem/Question/Abstract:

BDE alias info

Answer:

The following function uses the GetAliasParams method of TSession to get the directory mapping for an alias:

uses DbiProcs, DBiTypes;

function GetDataBaseDir(const Alias: string): string;
{* Will return the directory of the database given the alias
  (without trailing backslash) *}
var
  sp: PChar;
  Res: pDBDesc;
begin
  try
    New(Res);
    sp := StrAlloc(length(Alias) + 1);
    StrPCopy(sp, Alias);
    if DbiGetDatabaseDesc(sp, Res) = 0 then
      Result := StrPas(Res^.szPhyName)
    else
      Result := '';
  finally
    StrDispose(sp);
    Dispose(Res);
  end;
end;

DBGrid Component that show deleted and updated and inserted new records in diffrent colors

Problem/Question/Abstract:

DBGrid Show all state of the related DataSet

Answer:

This component show state of the related data set of DBGrid and used for data base controlers. It's appreciate to send any note or comment or suggestion to Vafaeija@yahoo.com

unit atcDBGrid;
{*
  (c) Aveen Tech
  2001 - 2002

  FileName: atcDBGrid.pas

  Version       Date            Author             Comment
  1.0           13/06/2000      Majid Vafai Jahan  Create.

OVERVIEW
  - This grid is inherited from DBGrid and add some required functionality to it.

Functionality:
  - Record type are all records that may be modified, unmodified, inserted, deleted.
  - Coloring according to Record type.
  - show selected Record Type.

*}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, dbTables, db;
const
  AlignFlags: array[TAlignment] of Integer =
  (DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
  RTL: array[Boolean] of Integer = (0, DT_RTLREADING);
type
  TCachedShow = (csModify, csUnModify, csRemoved, csInserted, csAll, csNormal);
  TatcDBGrid = class(TDBGrid)
  private
    FCachedShow: TCachedShow;
    FModifiedColor: TColor;
    FInsertedColor: TColor;
    FDeletedColor: TColor;
    procedure SetCachedShow(const Value: TCachedShow);
  protected
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); override;
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property atcCachedShow: TCachedShow read FCachedShow write SetCachedShow;
    property atcDeletedColor: TColor read FDeletedColor write FDeletedColor;
    property atcInsertedColor: TColor read FInsertedColor write FInsertedColor;
    property atcModifiedColor: TColor read FModifiedColor write FModifiedColor;
  end;

procedure Register;

implementation



procedure Register;
begin
  RegisterComponents('ATC DB Compo', [TatcDBGrid]);
end;



constructor TatcDBGrid.Create(AOwner: TComponent);
{*
  Description: Record Type Showing is All except Deletes.
*}

begin
  inherited;
  FCachedShow := csNormal;
  FDeletedColor := clGray;
  FInsertedColor := clAqua;
  FModifiedColor := clRed;
end;



procedure TatcDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
{*
  Description: On Drawing Column Color Updated Records.
*}
var
  ARect: TRect;
begin
  inherited;
  if not Assigned(Column.Field) then
    exit;
  // Copy Rect into Variable.
  CopyRect(ARect, Rect);
  if Assigned(DataLink) and (DataLink.Active) and (DataLink.DataSet <> nil) then
  begin
    // if current record is modified
    if DataLink.DataSet.UpdateStatus = usModified then
    begin
      Canvas.Brush.Color := atcModifiedColor;
      Canvas.Font.Color := clBlack;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text),
        ARect,
        AlignFlags[Column.Alignment] or
          RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
    end
      // if current record is inserted.
    else if DataLink.DataSet.UpdateStatus = usInserted then
    begin
      Canvas.Brush.Color := atcInsertedColor;
      Canvas.Font.Color := clBlack;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text),
        ARect,
        AlignFlags[Column.Alignment] or
          RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
    end
      // if current record is deleted.
    else if DataLink.DataSet.UpdateStatus = usDeleted then
    begin
      Canvas.Brush.Color := atcDeletedColor;
      Canvas.Font.Color := clWhite;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text),
        ARect,
        AlignFlags[Column.Alignment] or
          RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
    end;
  end;
end;



procedure TatcDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  State: TGridDrawState);
{*
  Description: Draw Cell
*}
var
  ARect: TRect;
begin
  inherited;
  CopyRect(ARect, Rect);

  if Assigned(DataLink) and (DataLink.Active) and (DataLink.DataSet <> nil) then
  begin
    // if current record is modified.
    if DataLink.DataSet.UpdateStatus = usModified then
    begin
      Canvas.Brush.Color := clRed;
      Canvas.Font.Color := clBlack;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
        AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field,
          Field.Alignment)]);
    end
      // if current record is inserted.
    else if DataLink.DataSet.UpdateStatus = usInserted then
    begin
      Canvas.Brush.Color := clAqua;
      Canvas.Font.Color := clBlack;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
        AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field,
          Field.Alignment)]);
    end
      // if current record is deleted.
    else if DataLink.DataSet.UpdateStatus = usDeleted then
    begin
      Canvas.Brush.Color := clGray;
      Canvas.Font.Color := clWhite;
      Canvas.FillRect(Rect);
      DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
        AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field,
          Field.Alignment)]);
    end;
  end;
end;



procedure TatcDBGrid.SetCachedShow(const Value: TCachedShow);
{*
  Description: Record type for showing in grid.
  Parameters: Value cached record show.
*}

begin
  FCachedShow := Value;
  if ComponentState = [csDesigning] then
    exit;
  if not Assigned(DataSource) or not Assigned(DataSource.DataSet) then
    exit;
  // for showing selected record type only.
  if Assigned(DataLink) and Assigned(DataLink.DataSet) and (DataLink.Active) then
  begin
    case FCachedShow of
      csAll:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified, rtInserted,
          rtDeleted, rtUnmodified];
      csModify:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified];
      csUnModify:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtUnmodified];
      csInserted:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtInserted];
      csRemoved:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtDeleted];
      csNormal:
        TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified, rtInserted,
          rtUnmodified];
    end;
  end;
end;


end.

Copy a Paradox table with all its family members from one place to another on my system

Problem/Question/Abstract:

How can I copy a Paradox table with all its family members from one place to another on my system?

Answer:

Introduction

When I discovered the TBatchMove component, it was a real god-send because I now had a means to copy and append data from one Paradox table to another, which was my desktop database of choice. But the one thing that irked me about it was that if I wanted to perform a physical copy of a table with all its indexes and other family members, TBatchMove wouldn't copy them. It would only copy the table itself.

An obvious workaround to this dilemma would be to do an operating system level copy of all files in the directory that have the same name as the table. But the problem with this is that a system-level copy is indescriminant of the file types that are being copied. What does this mean? Well, one thing is that if a subdirectory residing in the source directory happens to have the same name as the table, its entire contents will be copied to the destination. Also, the potential for copying other stray files with the same name but having no association with the table exists. So what happens is that you have to write a lot of logic just to deal with those two situations.

So, what do you do when there doesn't seem to be anything available in the VCL that will let you copy a table and all its associates at once. Even the TTable's BatchMove method won't do it. Well, when all else fails, go to the BDE itself.

When I was programming in Paradox and Paradox for Windows, I took it for granted that I could issue a Paradox copy command and all my tables and their family members would be copied all together. All that changed in Delphi, but that doesn't mean it's not available. It's just a matter of doing some programming. And surprisingly enough, it's not that hard to do.

Copying the File

Doing BDE stuff is rarely a one step operation. Usually, you have to instantiate or initialize a few things before you actually make the call you want to make. The BDE call that we want to perform the copy, DBICopyTable, is no exception. But thankfully, it only requires a single prerequisite object to be created before making the call. That object is simply a TDatabase object. DBICopyTable uses the TDatabase object's Handle property internally to get information about the file being copied. Specifically, once it has the handle to the object, it uses the Locale property information get the language driver information it needs so it knows what files to copy. Once we create the database object, we're ready to make the call. Let's look at it in detail.

DBICopyTable takes four (5) parameters. They're explained below:

Parameter Name
Type
Description
hDB
hDBIDb
In English, this is read Database Handle, the Handle property of a TDatabase object.
bOverwrite
Boolean
True = Overwrite the destination file if it exists
False = Don't overwrite. If the file exists, an exception will occur. This is trapped by the Check function which will also pop up a message describing the error.
pszSrcTableName
PChar
The fully qualified (path and file name) name of the source table to copy
pszSrcDriverType
PChar
The driver type of the source table. If you supply the file extension, you can set this to nil. Otherwise, you have to specify a valid driver type (i.e. 'STANDARD', SQLServer, etc.).
pszDestName
PChar
The fully qualified name of the destination table.


Here's some code that encapsulates the call (we'll discuss it below):

{========================================================================
This will copy a Paradox or dBase table from one directory to another.
Note that this does not use BDE aliases. It would be possible to do that
by declaring parameters for the source and destination databases,
respectively.}
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
  = = = = = = = = = = = = = = = = = = = = = = = = = = = =
procedure CopyPdoxTable(SrcTbl, DstTbl: string; Overwrite: Boolean);
var
  DB: TDatabase;
  STbl, DTbl: string;
begin
  {Since we're using path names and not BDE aliases, we have to do
   some checking of the paths to see if they're blank; that is, the
   user passed just the file name to the procedure, and not the
   FULLY QUALIFIED file name. In that case, we merely set the source
   and destination to the application's EXEName directory}
  if (ExtractFilePath(SrcTbl) = '') then
    STbl := ExtractFilePath(Application.EXEName) + SrcTbl
  else
    STbl := SrcTbl;

  if (ExtractFilePath(DstTbl) = '') then
    DTbl := ExtractFilePath(Application.EXEName) + DstTbl
  else
    DTbl := DstTbl;

  {First, check to see if the source file actually exists. If it does
  create a TDatabase that points to the source file's directory.
  This can actually point anywhere using the method we're using because
  we're specifying fully qualified file names as entries as opposed to.
        The important thing though, is to set it to a valid directory}
  if FileExists(STbl) then
  begin
    DB := TDatabase.Create(nil);
    with DB do
    begin
      Connected := False;
      DatabaseName := ExtractFilePath(SrcTbl);
      DriverName := 'STANDARD';
      Connected := True;
    end;

    {Do the table copy from source to dest. Notice the PChar typecast of STbl
     and DTbl. The BDE function actually calls for a DBITBLNAME type. But this
     is just a null-terminated string - a PChar - so we can save ourselves a
     lot of time by just typecasting the strings.}
    Check(DBICopyTable(DB.Handle, Overwrite, PChar(STbl), nil, PChar(DTbl)));

    //Get rid of the database component.
    DB.Free;
  end;
else
  ShowMessage('Could not copy the table. It is not in the location specified.');

end;

Note that the boldface type is the code you actually write. I did it this way because I added a lot of comments and they got in the way of the code.

So, what's going on in the code?

Well, the first thing that happens is a little sanity check. If only the file name of the table is passed to the procedure, it assumes that the file resides in the same directory as the application. Then the copying operation is enclosed in a conditional statement and only executes depending upon the existence of the file itself.

Once that's done, we create a TDatabase object in memory, set its DatabaseName property to the directory location of the file by calling ExtractFilePath, specify the STANDARD driver (Paradox and dBase files) as our table language driver, then connect. Pretty simple.

Then, it's a simple matter of calling DbiCopyTable, inputting the parameters described above. Notice that I enclose the call in the Check function. This is a special BDE call which checks the error constant returned from a BDE call. While the BDE is fairly complex, it's error tracking is fairly robust. In the old days of the BDE, you had to trap all the constants yourself, then display error messages depending upon the value returned. Check handles all that for you.

Well, that's it. Try it out and see how it works for you.

How to colorize an image

Problem/Question/Abstract:

How to colorize an image

Answer:

Assumes 8 bit R, G, Bs packed into RGB. Luma is 0 - 255


function Colorize(RGB, Luma: Cardinal);
var
  l, r, g, b: Single;
begin
  Result := Luma;
  if Luma = 0 then { it's all black anyway}
    Exit;
  l := Luma / 255;
  r := RGB and $FF * l;
  g := RGB shr 8 and $FF * l;
  b := RGB shr 16 and $FF * l;
  Result := Round(b) shl 16 or Round(g) shl 8 or Round(r);
end;

System menu in tray-icon mode

Problem/Question/Abstract:

I always wanted to show the Main window's system menu also when the only thing the user could click on the screen of my application, was the tray icon. Like Total Commander is doing...

Answer:

With the most components provinding very-easy-to-use icon tray support, you can specify to show up a popupmenu, or you can catch the click event.

But you can't easily show the same menu as if you right-clicked on application's taskbar icon.

Just catch the WM_CLICK event over the icon, or simply use the OnClick event as shown:

procedure TfrmMain.tiIconClick(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: HMenu;
begin
  I := GetSystemMenu(Handle, False);
  TrackPopupMenuEx(I, TPM_HORIZONTAL, X, Y, Handle, nil);
end;

Be warned: you must specify X and Y as screen coordinates, not relative to the icon, like some components do.

A Simple Property Editor

Problem/Question/Abstract:

How can I create a simple property editor?

Answer:

This is an introductory level article about creating a simple property editor that I hope will get you started. I'll provide enough information about the DSGNINTF.PAS (Design interface that holds the TPropertyEditor class) file so you can finish the article with a sense of that you are able to create a property editor.

TPropertyEditor

The following is a cut and paste of the TPropertyEditor class declaration found in DSGNINTF.PAS:

  TPropertyEditor = class
private
  FDesigner: TFormDesigner;
  FPropList: PInstPropList;
  FPropCount: Integer;
  constructor Create(ADesigner: TFormDesigner; APropCount: Integer);
  function GetPrivateDirectory: string;
  procedure SetPropEntry(Index: Integer; AInstance: TComponent;
    APropInfo: PPropInfo);
protected
  function GetPropInfo: PPropInfo;
  function GetFloatValue: Extended;
  function GetFloatValueAt(Index: Integer): Extended;
  function GetMethodValue: TMethod;
  function GetMethodValueAt(Index: Integer): TMethod;
  function GetOrdValue: Longint;
  function GetOrdValueAt(Index: Integer): Longint;
  function GetStrValue: string;
  function GetStrValueAt(Index: Integer): string;
  function GetVarValue: Variant;
  function GetVarValueAt(Index: Integer): Variant;
  procedure Modified;
  procedure SetFloatValue(Value: Extended);
  procedure SetMethodValue(const Value: TMethod);
  procedure SetOrdValue(Value: Longint);
  procedure SetStrValue(const Value: string);
  procedure SetVarValue(const Value: Variant);
public
  destructor Destroy; override;
  procedure Activate; virtual;
  function AllEqual: Boolean; virtual;
  procedure Edit; virtual;
  function GetAttributes: TPropertyAttributes; virtual;
  function GetComponent(Index: Integer): TComponent;
  function GetEditLimit: Integer; virtual;
  function GetName: string; virtual;
  procedure GetProperties(Proc: TGetPropEditProc); virtual;
  function GetPropType: PTypeInfo;
  function GetValue: string; virtual;
  procedure GetValues(Proc: TGetStrProc); virtual;
  procedure Initialize; virtual;
  procedure Revert;
  procedure SetValue(const Value: string); virtual;
  function ValueAvailable: Boolean;
  property Designer: TFormDesigner read FDesigner;
  property PrivateDirectory: string read GetPrivateDirectory;
  property PropCount: Integer read FPropCount;
  property Value: string read GetValue write SetValue;
end;

Whew! that's a lot of stuff, isn't it? Add to the fact that the Tools API is poorly documented, and you've got a lot confusion to deal with. There's a little relief in the Delphi 2.0 help file, but the way it's organized can leave you with the sinking feeling that you're in way over your head. After you've done a few property editors, it's really not that hard.

The Trick to Writing Property Editors

One of the biggest problems with technical documentation is that it's technical. Not much conceptual material is ever covered in tech specs or tech manuals. This leaves it up to the programmer to extrapolate the underlying concepts. I'm of the opinion that if something has the possibility of being a widely used feature, you should cover not only the technical specifications, but the conceptual points as well. Gaining conceptual understanding is the real trick to creating property.

The trick to writing property editors is understanding the virtual methods and what they do. Writing your own custom property editors is all about overriding the proper methods of the TPropertyEditor class to get the functionality out of property editor that you require. Granted, there are a lot of very complex property editors out there. But whether simple or complex, they're all built in a similar fashion: they override default functionality of TPropertyEditor.

Once you let this concept sink in, and as you gain more experience in building components, writing a property editor merely becomes the task of overriding the appropriate methods to get your job done.

Furthermore, the DSGNINFT.PAS is thoroughly commented. When constructing components that will have property editors, make sure that this file is open in the editor so you can refer to the documentation covering the virtual methods you will be overriding. As an aside, if you do BDE programming, having the BDE.INT (Delphi 2.0) or DBIPROCS.INT, DBITYPES.INT, DBIERRS.INT (Delphi 1.0) is essential to successful BDE programming

The Value List: the Simplest Type of Property Editor

Properties that display value lists are common to components. In fact, you see them all the time. For instance, a value list property that everyone has used is the Align property.

Value lists are simple enumerated types, which are merely a collection of sequentially ordered elements in a list. The first item has an ordinal value of 0, the second 1, and so forth. Enumerated types are useful in communicating with the user using a set of named choices rather than ordinal or numeric choices. For instance, the Align element alBottom is much easier to understand than '0,' which is its ordinal value in the list. In this case, the ordinal value has no clear conceptual context.

To create a property editor that presents a value list to a user in the object inspector is very simple and requires only a few steps. Here is a brief synopsis of what you have to do before we go into detail:

First, define and declare your enumerated type under a new type section.
Under the enumerated type declaration, declare your class, including the functions you will be overriding in your code.
Write your code in the implementation section of the unit.

Sounds pretty simple, right? It is. So let's go and create one now, then we'll discuss it in detail below.

...other code

interface

type
  TEnumMonth = (emJan, emFeb, emMar,
    emApr, emMay, emJun,
    emJul, emAug, emSep,
    emOct, emNov, emDec);

  TEnumMonths = class(TEnumProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function AllEqual: Boolean; override;
  end;

implementation

...other code

function TEnumMonths.AllEqual: Boolean;
begin
  Result := True;
end;

function TEnumMonths.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList];
end;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TEnumMonth), TPSIBaseExt, 'RangeBegin',
    TEnumMonths);
  RegisterPropertyEditor(TypeInfo(TEnumMonth), TPSIBaseExt, 'RangeEnd', TEnumMonths);
end;

The property editor listed above was created to serve a singular purpose: Allow the user to select a specific month from a list of months, rather than typing in a month value code himself (which is more work than the user needs and is also prone to spelling errors).

This component modernizes a cumbersome style of interaction in existing applications. In these applications users were required to enter month ranges as a six-digit string beginning with current two-digit year plus the four digit month/day combination (eg., YYMMDD). Past experience said that runtime errors or empty result sets from queries that used the range values were usually the result of mistyping. So the property editor was created to let the user pick a month for both the starting month and ending month of the range of values they wanted to extract. This explains why in the code above I registered the property editor for both the RangeBegin and RangeEnd properties.

Elsewhere in the component, I have created an array type of type String and created two arrays representing the starting month and ending month code values, respectively.

Here's the array type declaration:

type
  TMonthRng = array[0..11] of string;
  ....

Here are the declarations and initializations of the arrays themselves:

var
  stmonArr,
    enmonArr: TMonthRng;
begin
  stmonArr[0] := '0101';
  stmonArr[1] := '0201';
  stmonArr[2] := '0301';
  stmonArr[3] := '0401';
  stmonArr[4] := '0501';
  stmonArr[5] := '0601';
  stmonArr[6] := '0701';
  stmonArr[7] := '0801';
  stmonArr[8] := '0901';
  stmonArr[9] := '1001';
  stmonArr[10] := '1101';
  stmonArr[11] := '1201';
  enmonArr[0] := '0131';
  enmonArr[1] := '0229';
  enmonArr[2] := '0331';
  enmonArr[3] := '0430';
  enmonArr[4] := '0531';
  enmonArr[5] := '0630';
  enmonArr[6] := '0731';
  enmonArr[7] := '0831';
  enmonArr[8] := '0930';
  enmonArr[9] := '1031';
  enmonArr[10] := '1130';
  enmonArr[11] := '1231';

  ...

By doing things in this manner, one can easily get the appropriate value needed by passing the ordinal value of the appropriate enumerated type as an index of an element in the array. For example, let's say the user chose emApr as his/her starting month. The ordinal value of emApr is 3. Referencing that value in the stmonArr array would produce the string '0401.' What I've essentially done here is eliminate the need for the user to do anything more than choose an appropriate month to start with. The proper code is handled by the program. Here's some sample code that demonstrates how it's done:

procedure ReturnMonthCode(Index: Integer; StartMonth: Boolean): string;
var
  stmonArr,
    enmonArr: TMonthRng;
begin
  stmonArr[0] := '0101';
  stmonArr[1] := '0201';
  stmonArr[2] := '0301';
  stmonArr[3] := '0401';
  stmonArr[4] := '0501';
  stmonArr[5] := '0601';
  stmonArr[6] := '0701';
  stmonArr[7] := '0801';
  stmonArr[8] := '0901';
  stmonArr[9] := '1001';
  stmonArr[10] := '1101';
  stmonArr[11] := '1201';

  enmonArr[0] := '0131';
  enmonArr[1] := '0229';
  enmonArr[2] := '0331';
  enmonArr[3] := '0430';
  enmonArr[4] := '0531';
  enmonArr[5] := '0630';
  enmonArr[6] := '0731';
  enmonArr[7] := '0831';
  enmonArr[8] := '0930';
  enmonArr[9] := '1031';
  enmonArr[10] := '1130';
  enmonArr[11] := '1231';

  if StartMonth then
    Result := stMonArr[Index]
  else
    Result := enMonArr[Index];
end;

To actually use ReturnMonthCode all we do is the following:

var
  S: string;
begin

  S := ReturnMonthCode(Ord(RangeBegin), True);

Remember, RangeBegin is a property of type TEnumArray. Therefore, to access its ordinal value, all we need do is apply the Ord function to it.

Based on the information above, you should be able to create at the very least a simple property editor like the example above. For more complex property editors, you will have to override more of the methods; but remember, don't be daunted by the code. The trick is overriding the default methods with your own.

How to detect if DCOM is installed

Problem/Question/Abstract:

How to detect if DCOM is installed

Answer:

function IsDCOMInstalled: Boolean;
var
  OLE32: HModule;
begin
  Result := not (IsWin95 or IsWin95OSR2);
  if not Result then
  begin
    OLE32 := LoadLibrary(COLE32DLL);
    if OLE32 > 0 then
    try
      Result := GetProcAddress(OLE32, PChar('CoCreateInstanceEx')) <> nil;
    finally
      FreeLibrary(OLE32);
    end;
  end;
end;

How to read the file header of a wave file

Problem/Question/Abstract:

I want to open a wave file in my application, but how do I know that it is really a wave file and not just a file with *.wav extension?

Answer:

First you have to know what the structure of a wave file is. I'd create a record which represent this structure:


type
  TWaveHeader = record
    ident1: array[0..3] of Char;      // Must be "RIFF"
    len: DWORD;                       // Remaining length after this header
    ident2: array[0..3] of Char;      // Must be "WAVE"
    ident3: array[0..3] of Char;      // Must be "fmt "
    reserv: DWORD;                    // Reserved 4 bytes
    wFormatTag: Word;                 // format type
    nChannels: Word;                  // number of channels (i.e. mono, stereo, etc.)
    nSamplesPerSec: DWORD;            //sample rate
    nAvgBytesPerSec: DWORD;           //for buffer estimation
    nBlockAlign: Word;                //block size of data
    wBitsPerSample: Word;             //number of bits per sample of mono data
    cbSize: Word;                     //the count in bytes of the size of
    ident4: array[0..3] of Char;      //Must be "data"
end;


With this structure you can get all the information's about a wave file you want to.
After this header following the wave data which contains the data for playing the wave file.

Now we trying to get the information's from a wave file. To be sure it's really a wave file, we test the information's:


function GetWaveHeader(FileName: TFilename): TWaveHeader;
const
  riff = 'RIFF';
  wave = 'WAVE';
var
  f: TFileStream;
  w: TWaveHeader;
begin
  if not FileExists(Filename) then
    exit; //exit the function if the file does not exists

  try
    f := TFileStream.create(Filename, fmOpenRead);
    f.Read(w, Sizeof(w)); //Reading the file header

    if w.ident1 <> riff then
    begin //Test if it is a RIFF file, otherwise exit
      Showmessage('This is not a RIFF File');
      exit;
    end;

    if w.ident2 <> wave then
    begin //Test if it is a wave file, otherwise exit
      Showmessage('This is not a valid wave file');
      exit;
    end;

  finally
    f.free;
  end;

  Result := w;
end;



I hope this example will help you to work with wave files in your application.