Convert 8 or 16 bit color images to 32 bit

Problem/Question/Abstract:

How do I convert a 8 bit color image or a 16 bit color image to 32 bits of color? In my case, I have files with 8bit or 16bit images which I read using scanline. So I have one or two bytes determining the pixel color. What I want to do is still read one or two bytes for each pixel, for either the 8bit or the 16bit, but convert it to 32 bits on display.

Answer:

I think you mean 8 or 16 bit per pixel, not 8 or 16 per sample. You must divide the 8 bit and the 16 bit. 8 bit is a indexed image (palette image). The pixel value is an index in a color table (palette). You need a pointer to this color table and get the color from this table. 16 bit is an RGB image, the pixel directly contains the color data. Unfortunately, you must determine the pixel mask. On Win9x the data can be 5 bit blue, 6 bit green, 5 bit red or 5 bit blue, 5 bit green, 5 bit red (bit 15 is unused). On WinNT or later the data can be stored in other combinations, but this is unlikely.

From a own project to convert such pixel data:

function DIB555ToBGR(Value: DWord): DWord; assembler;
asm
  {blue}
  mov   ecx, eax
  shl   eax, 3
  mov   edx, eax
  and   eax, $0000F8
  shr   ecx, 2
  and   ecx, $000007
  or    eax, ecx
  {green}
  shl   edx, 3
  mov   ecx, edx
  and   edx, $00F800
  or    eax, edx
  shr   edx, 5
  and   edx, $000700
  or    eax, edx
  {red}
  shl   ecx, 3
  and   ecx, $F80000
  or    eax, ecx
  shr   ecx, 5
  and   ecx, $070000
  or    eax, ecx
end;

function DIB565ToBGR(Value: DWord): DWord; assembler;
asm
  {blue}
  mov   ecx, eax
  shl   eax, 3
  mov   edx, eax
  and   eax, $0000F8
  shr   ecx, 2
  and   ecx, $000007
  or    eax, ecx
  {green}
  shl   edx, 2
  mov   ecx, edx
  and   edx, $00FC00
  or    eax, edx
  shr   edx, 6
  and   edx, $000300
  or    eax, edx
  {red}
  shl   ecx, 3
  and   ecx, $F80000
  or    eax, ecx
  shr   ecx, 5
  and   ecx, $070000
  or    eax, ecx
end;

However, I think you should simple use TBitmap.PixelFormat:

PixelFormat := pf32Bit;

This sets the bitmap to 32 Bit.

On the other side, you can directly display the 8 or 16 bit bitmap, the WinAPI convert the bitmap to the correct format.

Coloring Cells in a StringGrid / DBGrid

Problem/Question/Abstract:

StringGrids / DBGrids with colored cells looks very nice and you can inform the user about importent data inside the Grid.

Answer:

Unfortunately you can't use the same method for coloring StringGrids and DBGrids. So first let's have a look to the StringGrid:

1. StringGrid

Use the "OnDrawCell"-event to make your StringGrids colorful! The following Code shows how to give your Grid a red background color. The second column will be colored with green background.

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

const //define your color here. Of course you
  //can use default colors too.
  clPaleGreen = TColor($CCFFCC);
  clPaleRed = TColor($CCCCFF);

begin

  //Does the cell have the focus you have to paint it with other colors
  if (gdFocused in State) then
  begin
    StringGrid1.Canvas.Brush.Color := clBlack;
    StringGrid1.Canvas.Font.Color := clWhite;
  end
  else //Does the cell have NOT the focus you can use
    //your personal colors here
    if ACol = 2 //the second Column should be
    {//green, the other cells red } then
      StringGrid1.Canvas.Brush.color := clPaleGreen
    else
      StringGrid1.canvas.brush.Color := clPaleRed;

  //Now Paint the cells, but only, if the cell isn't the Title- Row/Column
  //This of course depends whether you have title-Row/Columns or not.

  if (ACol > 0) and (ARow > 0) then
  begin
    //Painting the Background
    StringGrid1.canvas.fillRect(Rect);

    //Painting the Text. Here you can improve the code with
    // using alignment and so on.
    StringGrid1.canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
  end;
end;

If you want to colorize your cells depending on values in the cells you can replace the 3 lines (if Acol = 2 ......) with something like this

if StringGrid1.Cells[ACol, ARow] = 'highlight it' then
  StringGrid1.Canvas.Brush.color := clPalered
else
  StringGrid1.canvas.brush.Color := clwhite;

But now lets coloring DBGrids:

2. DBGrid

It's much easier to give color to DBGrids. Here you have to use the "OnDrawColumnCell"-Event. The following example is coloring the Cells of Column "Status" when the value is not "a".
If you want to color the whole line you only have to delete the "If..." statement (see below)

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
const
  clPaleGreen = TColor($CCFFCC);
  clPaleRed = TColor($CCCCFF);
begin

  if Column.FieldName = 'Status' then //Remove this line, if you want
    //to highlight the whole line

    if Column.Field.Dataset.FieldbyName('Status').AsString <> 'a' then
      if (gdFocused in State) {//does the cell have the focus? } then
        dbgrid1.canvas.brush.color := clBlack //focused
      else
        dbgrid1.canvas.brush.color := clPaleGreen; //not focused

  //Now let's paint the cell using a Default-Method:
  dbgrid1.DefaultDrawColumnCell(rect, DataCol, Column, State)
end;

How to draw text on the Windows taskbar

Problem/Question/Abstract:

Does anyone know how to write a text on the main taskbar in Win95 using Delphi 3.0?

Answer:

This modified splash procedure that I use draws text directly on the Start button. Perhaps it helps. I normally use it to draw splash text directly on screen. To do that, use DC:= GetDC(0):


procedure TForm1.Button1Click(Sender: TObject);
var
  DC: hDC;
  Size: TSize;
  Font: hFont;
const
  DispText = 'Test';
begin
  DC := GetDC(GetDlgItem(FindWindow(PChar('Shell_TrayWnd'), nil), $130));
  ShowMessage(IntToStr(GetDlgItem(FindWindow(PChar('Shell_TrayWnd'), nil), $130)));
  SetBkMode(DC, TRANSPARENT);
  Font := CreateFont(12, 10, 0, 0, 1000, 0, 0, 0, ANSI_CHARSET, OUT_DEVICE_PRECIS,
    CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, 'ARIAL');
  SelectObject(DC, Font);
  SetTextColor(DC, RGB(128, 128, 0));
  GetTextExtentPoint(DC, PChar(DispText), Length(DispText), Size);
  TextOut(DC, 0, 0, PChar(DispText), Length(DispText));
  DeleteObject(Font);
  ReleaseDC(GetDlgItem(FindWindow(PChar('Shell_TrayWnd'), nil), $130), DC);
end;

How to use a TImage as the background for a TDBGrid

Problem/Question/Abstract:

I would like to have a DBGrid on a form that contains a bitmap and have the text in the cells of the grid float on the bitmap. I've tried using SetBKMode but apparently I'm using it incorrectly. Is there a separate canvas for each cell as well as the grid itself?

Answer:

Place a TImage on a form or create it off-screen and put the following (untested) code in the OnDrawColumnCell event of the grid:


procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  w, h: Integer;
begin
  with DBGrid1.Canvas do
  begin
    w := Rect.Right - Rect.Left;
    h := Rect.Bottom - Rect.Top;
    BitBlt(DBGrid1.Canvas.Handle, Rect.Left, Rect.Top, w, h,
      Image1.Picture.Bitmap.Canvas.Handle, Rect.Left, Rect.Top, SRCCOPY);
    Brush.Style := bsClear;
    TextOut(Rect.left, Rect.Top, Column.Field.AsString);
  end;
end;

Return identity id from insert_SQL

Problem/Question/Abstract:

How can i obtain the value of the identity column in a table, when inserting a record with a INSERT SQL statement.

Answer:

Found the following note when surfing several sql-dba website forums:

You can use the SET NOCOUNT statement. SET NOCOUNT ON will prevent SQL Server from telling you how many rows each statement affected. SET NOCOUNT OFF will return SQL Server back to it's default setting. The variable @@ROWCOUNT will always contain the number of rows affected by the previous statement regardless of the setting of NOCOUNT

do use this statement to obtain the value of the inserted id:

whe have a table called TheTable with fields:

Field_ID (identity column)
Field001 (varchar)
Field002 (int)

Set Nocount on
Insert TheTable (Field001, Field002)
VALUES ('ABC', 1)
select IdentityInsert=@@identity
set nocount off

Example usage:

I have an order table with the primary order data, and a related table called orderdetails with the orderdetails per primary order data. The primary order table contains a key, field OrderID, of type identity-column autoincrement start at 0 and increment with 1. The table orderdetails contains the orderId as foreign key.

Case asp e-business website:

The visitor wants to checkout the order wich is composed. Now fire the insert sql to insert a record in the primary order table, using the script in this article to obtain the order id. With the obtained order id fire the several sql_inserts into the the order details table.

Tested with sqlserver 7, ado, d5, asp

Create a Menu from XML-File

Problem/Question/Abstract:

How can you build up the content of e.g. a TMainMenu from a XML-File?

Perhaps you have a program which also includes an administration part for a database, but only some users should be able to see and use this administration part. Why don't create a XML-File, which contains the menu of the program. When the program starts, it builds its menu from this XML-File. And only the people who should be able to see and use the administration part get the XML-File which contains it, all other users have a file without this part.

This way it's very hard for hackers to get into the administration part.

And when you even encrypt your XML-File, it should nearly unpossible.

But how can we do this?

Answer:

A special feature of the code below: You only need to specify the Name of the procedure which then
will be attached to a OnClick handler (but all this procedures MUST be public)

At first, insert this code in your mainform and add a TMainMenu (without any content) and a TXMLDocument to your form.

procedure TMainForm.CreateMenuFromXMLFile;

  function Get_Int(S: string): Integer;
  begin
    Result := 0;
    try
      Result := StrToInt(S);
    except
    end;
  end;

  procedure AddRecursive(Parent: TMenuItem; Item: IXMLNode);
  var
    I: Integer;
    Node: TMenuItem;
    Child: IXMLNode;
    Address: TMethod;
  begin
    Node := TMenuItem.Create(Parent);
    if (Uppercase(Item.Attributes['CAPTION']) <> 'SEPERATOR') then
    begin
      Node.Caption := Item.Attributes['CAPTION'];
      if (Uppercase(Item.Attributes['ID']) <> 'NONE') then
      begin
        Address.Code := MethodAddress(Item.Attributes['ID']);
        Address.Data := Self;
        if (Item.ChildNodes.Count - 1 < 0) then
          Node.OnClick := TNotifyEvent(Address);
      end;
      if (Uppercase(Item.Attributes['SHORTCUT']) <> 'NONE') then
        Node.ShortCut := TextToShortCut(Item.Attributes['SHORTCUT']);
      Node.Checked := (Item.Attributes['CHECKED'] = '1');
    end
    else
      Node.Caption := '-';
    Node.Visible := (Item.Attributes['VISIBLE'] = '1');
    if Parent <> nil then
      Parent.Add(Node)
    else
      MainMenu.Items.Add(Node);

    for I := 0 to Item.ChildNodes.Count - 1 do
    begin
      Child := item.ChildNodes[i];
      if (Child.NodeName = 'ENTRY') then
        AddRecursive(Node, Child);
    end;
  end;

var
  Root: IXMLMENUType;
  Parent: TMenuItem;
  I: Integer;
  Child: IXMLNode;
begin
  XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile;
  if not FileExists(XMLDocument.FileName) then
  begin
    MessageDlg('Menu-XML-Document not found!', mtError, [mbOK], 0);
    Halt;
  end;
  XMLDocument.Active := True;

  Screen.Cursor := crHourglass;
  try
    Root := GetXMLMenu(XMLDocument);
    Parent := nil;

    for I := 0 to Root.ChildNodes.Count - 1 do
    begin
      Child := Root.ChildNodes[i];
      if (Child.NodeName = 'ENTRY') then
        AddRecursive(Parent, Child);
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;



This was the first step.
You also need the encapsulation of the XML-File.
( Save the code below as unit and add it to your program.
Created with Delphi6 -> New -> XML Data Binding Wizard )

{***************************************************}
{                                                   }
{ Delphi XML-Datenbindung                           }
{                                                   }
{ Erzeugt am: 27.06.2002 13:25:01                   }
{                                                   }
{***************************************************}

unit XMLMenuTranslation;

interface

uses xmldom, XMLDoc, XMLIntf;

type

  { Forward-Deklarationen }

  IXMLMENUType = interface;
  IXMLENTRYType = interface;

  { IXMLMENUType }

  IXMLMENUType = interface(IXMLNode)
    ['{8F36F5E2-834F-41D9-918F-9B1A441C9074}']
    { Zugriff auf Eigenschaften }
    function Get_ENTRY: IXMLENTRYType;
    { Methoden & Eigenschaften }
    property ENTRY: IXMLENTRYType read Get_ENTRY;
  end;

  { IXMLENTRYType }

  IXMLENTRYType = interface(IXMLNode)
    ['{AD85CD05-725E-40F8-A8D7-D6EC05FD4360}']
    { Zugriff auf Eigenschaften }
    function Get_CAPTION: WideString;
    function Get_VISIBLE: Integer;
    function Get_ID: Integer;
    function Get_ENTRY: IXMLENTRYType;
    procedure Set_CAPTION(Value: WideString);
    procedure Set_VISIBLE(Value: Integer);
    procedure Set_ID(Value: Integer);
    { Methoden & Eigenschaften }
    property Caption: WideString read Get_CAPTION write Set_CAPTION;
    property Visible: Integer read Get_VISIBLE write Set_VISIBLE;
    property ID: Integer read Get_ID write Set_ID;
    property ENTRY: IXMLENTRYType read Get_ENTRY;
  end;

  { Forward-Deklarationen }

  TXMLMENUType = class;
  TXMLENTRYType = class;

  { TXMLMENUType }

  TXMLMENUType = class(TXMLNode, IXMLMENUType)
  protected
    { IXMLMENUType }
    function Get_ENTRY: IXMLENTRYType;
  public
    procedure AfterConstruction; override;
  end;

  { TXMLENTRYType }

  TXMLENTRYType = class(TXMLNode, IXMLENTRYType)
  protected
    { IXMLENTRYType }
    function Get_CAPTION: WideString;
    function Get_VISIBLE: Integer;
    function Get_ID: Integer;
    function Get_ENTRY: IXMLENTRYType;
    procedure Set_CAPTION(Value: WideString);
    procedure Set_VISIBLE(Value: Integer);
    procedure Set_ID(Value: Integer);
  public
    procedure AfterConstruction; override;
  end;

  { Globale Funktionen }

function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
function LoadMENU(const FileName: WideString): IXMLMENUType;
function NewMENU: IXMLMENUType;

implementation

{ Globale Funktionen }

function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
begin
  Result := Doc.GetDocBinding('MENU', TXMLMENUType) as IXMLMENUType;
end;

function LoadMENU(const FileName: WideString): IXMLMENUType;
begin
  Result := LoadXMLDocument(FileName).GetDocBinding('MENU', TXMLMENUType) as
    IXMLMENUType;
end;

function NewMENU: IXMLMENUType;
begin
  Result := NewXMLDocument.GetDocBinding('MENU', TXMLMENUType) as IXMLMENUType;
end;

{ TXMLMENUType }

procedure TXMLMENUType.AfterConstruction;
begin
  RegisterChildNode('ENTRY', TXMLENTRYType);
  inherited;
end;

function TXMLMENUType.Get_ENTRY: IXMLENTRYType;
begin
  Result := ChildNodes['ENTRY'] as IXMLENTRYType;
end;

{ TXMLENTRYType }

procedure TXMLENTRYType.AfterConstruction;
begin
  RegisterChildNode('ENTRY', TXMLENTRYType);
  inherited;
end;

function TXMLENTRYType.Get_CAPTION: WideString;
begin
  Result := ChildNodes['CAPTION'].Text;
end;

procedure TXMLENTRYType.Set_CAPTION(Value: WideString);
begin
  ChildNodes['CAPTION'].NodeValue := Value;
end;

function TXMLENTRYType.Get_VISIBLE: Integer;
begin
  Result := ChildNodes['VISIBLE'].NodeValue;
end;

procedure TXMLENTRYType.Set_VISIBLE(Value: Integer);
begin
  ChildNodes['VISIBLE'].NodeValue := Value;
end;

function TXMLENTRYType.Get_ID: Integer;
begin
  Result := ChildNodes['ID'].NodeValue;
end;

procedure TXMLENTRYType.Set_ID(Value: Integer);
begin
  ChildNodes['ID'].NodeValue := Value;
end;

function TXMLENTRYType.Get_ENTRY: IXMLENTRYType;
begin
  Result := ChildNodes['ENTRY'] as IXMLENTRYType;
end;

end.


Finally, I'll show you an example for the XML-File.
The Procedure Name is assigned to the ID which then will be called.

<?xml version="1.0" encoding="ISO-8859-1"?>
<MENU>
        <ENTRY CAPTION="Datei" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
                <ENTRY CAPTION="Beenden" VISIBLE="1" ID="CloseProgram" SHORTCUT="Strg+X" CHECKED="0"></ENTRY>
        </ENTRY>

        <ENTRY CAPTION="Anzeige" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
                <ENTRY CAPTION="Toolbar" VISIBLE="1" ID="ShowToolbar" SHORTCUT="None" CHECKED="1"></ENTRY>
                <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
                <ENTRY CAPTION="Optionen" VISIBLE="1" ID="ShowOptionen" SHORTCUT="Strg+O" CHECKED="0"></ENTRY>
        </ENTRY>

        <ENTRY CAPTION="News" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
                <ENTRY CAPTION="Refresh" VISIBLE="1" ID="RefreshAll" SHORTCUT="F5" CHECKED="0"></ENTRY>
                <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
                <ENTRY CAPTION="Administration" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
                        <ENTRY CAPTION="neue Nachricht hinzuf�gen" VISIBLE="1" ID="NewMarkedNews"         SHORTCUT="Strg+N" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="markierte Nachricht bearbeiten" VISIBLE="1" ID="EditMarkedNews" SHORTCUT="Strg+E" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="markierte Nachricht l�schen" VISIBLE="1" ID="DeleteMarkedNews" SHORTCUT="None" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
                        <ENTRY CAPTION="Film hinzuf�gen" VISIBLE="1" ID="AddMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="markierten Film l�schen" VISIBLE="1" ID="DeleteMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
                </ENTRY>
        </ENTRY>

        <ENTRY CAPTION="Hilfe" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
                <ENTRY CAPTION="LogView" VISIBLE="1" ID="ShowLog" SHORTCUT="Strg+L" CHECKED="0"></ENTRY>
                <ENTRY CAPTION="eMail schreiben" VISIBLE="1" ID="WriteEMail" SHORTCUT="None" CHECKED="0"></ENTRY>
                <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
                <ENTRY CAPTION="�ber" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY>
        </ENTRY>

</MENU>



The first Node should be <MENU> ... </MENU>

There you can the use <ENTRY ...></ENTRY>. When you write another entry before the Entry-Endtag, this will be a submenu item.

The parameters for ENTRY are:

CAPTION - this is the string which is displayed in the Menu. If this string is "Seperator", a Seperator will be insert
VISIBLE - when zero, the MenuItem will be generated but not displayed
ID - this is None for nothing or the Name of the procedure to call when the Item is clicked (BUT BE CAREFUL: THIS PROCEDURE MUST BE PUBLIC!)
SHORTCUT - None for nothing or e.g. Ctrl+X (read the Delphi-Help for 'TextToShortCut' to understand this)
CHECKED - when not zero, the MenuItem will be checked

How to track a TEdit at an OnExit event

Problem/Question/Abstract:

I'm getting a trouble with an special event inside a OnExit event. I need to know at OnExit of a TEdit Control, when the user clicks a button such as the Cancel button. The user may exit the TEdit just with a correct data or when the Cancel Button was clicked. How can I track this?

Answer:

Assuming that "BlockExit" is a global variable or field of your form:

procedure TForm1.FormCreate(Sender: TObject);
begin
  BlockExit := false;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  BlockExit := (Edit1.Text <> 'OK');
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if BlockExit then
  begin
    Beep;
    Beep;
    MessageDlg('Wrong data in Edit1', mtError, [mbOK], -1);
    Edit1.SetFocus;
    CanClose := false;
  end
  else
    CanClose := true;
end;

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  BlockExit := false;
  Close;
end;

procedure TForm1.btnOKClick(Sender: TObject);
begin
  Close;
end;

How to determine the caret position in a TMemo

Problem/Question/Abstract:

How to determine the caret position in a TMemo

Answer:

You can use the Windows API messages EM_LINEFROMCHAR and EM_LINEINDEX to determine the current line and offset within that line (starting from SelStart).

var
  LineNum: longint;
  CharsBeforeLine: longint;
begin
  LineNum := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
  CharsBeforeLine := SendMessage(Memo1.Handle, EM_LINEINDEX, LineNum, 0);
  Label1.Caption := ' Line ' + IntToStr(LineNum + 1);
  Label2.Caption := ' Position ' + IntToStr((Memo1.SelStart - CharsBeforeLine) + 1);
end;

Select first five records from table

Problem/Question/Abstract:

How to select first five records from table

Answer:

I know that SQL looks like easy thing but sometimes we face some problems, try this solvation.

SELECT TOP 5 Field1, Field2, ....FROM Table1...

Check if Internet Explorer is running and get the source of the page that is displayed

Problem/Question/Abstract:

I need to identify if IE is already running on the machine, and if so, read the source of the HTML being displayed

Answer:

{ ... }

uses
  SHDocVw, MSHtml;

{ ...}
var
  ShellWindows: IShellWindows;
  Browser: IWebBrowser2;
  i: integer;
  Doc: IHTMLDocument2;
  { ...}
    { Use ShellWindows to get the active browser window }
  ShellWindows := CoShellWindows.Create;
  for i := 0 to ShellWindows.Count - 1 do
  begin
    if Supports(ShellWindows.Item(i), IWebBrowser2, Browser) then
    begin
      Doc := Browser.Document as IHTMLDocument2;
      Memo1.Clear;
      Memo1.Lines.Add(Doc.body.innerText);
      { ...}

Copy directory structures

Problem/Question/Abstract:

How to copy directory structures

Answer:

Solve 1:

The most appropriate way would be with the SHFileOperation API call. This is a snippet of a demo I have written for this. You should be able to see the functionality.

procedure TForm1.SHFileOperationCopy(sFrom, sTo, STitle: string);
var
  lpFileOp: TSHFILEOPSTRUCT;
  op, flag: Integer;
begin
  case rgOP.ItemIndex of
    0: op := FO_COPY;
    1: op := FO_DELETE;
    2: op := FO_MOVE;
    3: op := FO_RENAME;
  end;
  flag := 0;
  if AllowUndo.Checked then
    flag := flag or FOF_ALLOWUNDO;
  if ConfirmMouse.checked then
    flag := flag or FOF_CONFIRMMOUSE;
  if FilesOnly.checked then
    flag := flag or FOF_FILESONLY;
  if NoConfirm.Checked then
    flag := flag or FOF_NOCONFIRMATION;
  if NoConfirmMkdir.Checked then
    flag := flag or FOF_NOCONFIRMMKDIR;
  if RenameColl.Checked then
    flag := flag or FOF_RENAMEONCOLLISION;
  if Silent.Checked then
    flag := flag or FOF_SILENT;
  if SimpleProgress.Checked then
    flag := flag or FOF_SIMPLEPROGRESS;
  with lpFileOp do
  begin
    Wnd := Form1.Handle;
    wFunc := op;
    pFrom := pChar(sFrom);
    pTo := pChar(sTo);
    fFlags := Flag;
    hNameMappings := nil;
    lpszProgressTitle := pChar(sTitle);
  end;
  if (SHFileOperation(lpFileOp) <> 0) then
    ShowMessage('Error processing request.');
  if lpFileOp.fAnyOperationsAborted then
    ShowMessage('Operation Aborted');
end;


Solve 2:

Here is desired function - with recursion:

function copyfilesindir(const source, dest, mask: string; subdirs: Boolean): Boolean;
var
  ts: TSearchRec;

  function filewithpath(const dir, file: string): string;
  begin
    if (length(dir) > 0) and (copy(dir, length(dir), 1) <> '\') then
      result := dir + '\' + file
    else
      result := dir + file;
  end;

begin
  result := directoryexists(dest);
  if not result then
    result := createdir(dest);
  if not result then
    exit;
  if findfirst(filewithpath(source, mask), faanyfile, ts) = 0 then
    repeat
      if not ((ts.name = '.') or (ts.name = '..')) then
      begin
        if ts.Attr and fadirectory > 0 then
        begin
          if subdirs then
            result := copyfilesindir(filewithpath(source, ts.name),
              filewithpath(dest, ts.name), mask, subdirs);
        end
        else
          result := copyfile(pchar(filewithpath(source, ts.name)),
            pchar(filewithpath(dest, ts.name)), false);
        if not result then
          break;
      end;
    until
      findnext(ts) <> 0;
  findclose(ts);
end;

How to convert UNIX time to TDateTime and vice versa

Problem/Question/Abstract:

There is a date/ time format that I'm trying to translate, but I can't find anything that could match. This example is 2000-12-20 around 22:15. Integer: 977347109, Hex: 3A412225. Anyone know how to translate it?

Answer:

The value is a Unix Time, defined as seconds since 1970-01-01T00:00:00,0Z. Important is the Letter Z, you live in Sweden, in consequence you must add 1 hour for StandardDate and 2 hours for DaylightDate to the date. The infos you can get with GetTimeZoneInformation. But you must determine, which Bias (Standard or Daylight) is valid for the date (in this case -60). You can convert the date value with the function below.

The Date for 977347109 is 2000-12-20T22:18:29+01:00.

const
  UnixDateDelta = 25569; { 1970-01-01T00:00:00,0 }
  SecPerMin = 60;
  SecPerHour = SecPerMin * 60;
  SecPerDay = SecPerHour * 24;
  MinDayFraction = 1 / (24 * 60);

  {Convert Unix time to TDatetime}

function UnixTimeToDateTime(AUnixTime: DWord; ABias: Integer): TDateTime;
begin
  Result := UnixDateDelta + (AUnixTime div SecPerDay) { Days }
  + ((AUnixTime mod SecPerDay) / SecPerDay) { Seconds }
  - ABias * MinDayFraction { Bias to UTC in minutes };
end;

{Convert Unix time to String with locale settings}

function UnixTimeToStr(AUnixTime: DWord; ABias: Integer): string;
begin
  Result := FormatDateTime('ddddd  hh:nn:ss', UnixTimeToDateTime(AUnixTime, ABias));
end;

{Convert TDateTime to Unix time}

function DateTimeToUnixTime(ADateTime: TDateTime; ABias: Integer): DWord;
begin
  Result := Trunc((ADateTime - UnixDateDelta) * SecPerDay) + ABias * SecPerMin;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Label1.Caption := UnixTimeToStr(977347109, -60);
end;

Create without worrying of destroy a component

Problem/Question/Abstract:

How can I prevent resources leak.

Answer:

Make use of Interface characteristic where when the reference goes out of scope it will free itself.

type
  IAutoClean = interface
    ['{61D9CBA6-B1CE-4297-9319-66CC86CE6922}']
  end;

  TAutoClean = class(TInterfacedObject, IAutoClean)
  private
    FObj: TObject;
  public
    constructor Create(AObj: TObject);
    destructor Destroy; override;
  end;

implementation

constructor TAutoClean.Create(AObj: TObject);
begin
  FObj := AObj;
end;

destructor TAutoClean.Destroy;
begin
  FreeAndNil(FObj);
  inherited;
end;

Application....

procedure TForm1.Button1Click(Sender: TObject);
var
  a: IAutoClean;
    //must declare as local variable, so when this procedure finished, it's out of scope
  o: TOpenDialog; //any component
begin
  o := TOpenDialog.Create(self);
  a := TAutoClean.Create(o);
  if o.Execute then
    ShowMessage(o.FileName);
end;

Achieve Record locking with MSSQL 7 or later

Problem/Question/Abstract:

How would you like to be able to determine if a record has been locked in MSSQL Server and not get that annoying 'Record has been changed by another User' when you finally try to post your changes? There is an easy approach (quite easy) but it has to be implemented programatically.

Answer:

For every record you want to lock to this:
Create a global temporary table that is named after the table on which the record is, together with the Unique Id of the table. For example, if you have a table named customers, with a unique id field called Uid and you want to lock the record with uid=14, create the table using this query:

  Create table ##Customers14 (id int null)

When you want to unlock the record just drop that table:

  Drop table ##Customers14

Now lets say that another user wants to use the same record. His client program tries to create the same global temporary table, but fails with an exception, because no two global temporary tables can have the same name. Trap the exception in a try-except clause and you are home free.

TIPS.

Use this only for SQLServer 7 and above. SQL 6.5 and below have a terrible way of handling Temprorary tables that gives a lot of overhead.

You can create any kind of collumn in your temporary table, so you can have info like what time the record was locked and by what user.

Never use this approach if there is a chance someone will forget his computer open on a record for hours, and that computer is located lets say 100 miles  from the server!!!

If the connection is lost by lets say an application error, the table is automatically droped by the SQL Server.

If the computer shutsdown by a power failure, the SQL Server waits for about 15 minutes and then drops the temporary table, or if the computer logs on again  the table is droped automatically.

If you don't want to have to handle an exception you can also check for the existance of the Temporary table in the Master database.

How to copy multiple files into one

Problem/Question/Abstract:

Remember DOS? We can combine multiple ASCII files to one by using the copy command like: copy file1 + file2 + file3 file4 .That makes file4 to become the sum of file1, file2 and file3. Does the ShFileOperation API supports this feature or is there any other API support this?

Answer:

Solve 1:

procedure TForm1.Button1Click(Sender: TObject);
var
  Stream1, Stream2: TFileStream;
begin
  Stream1 := TFileStream.Create('c:\file4', fmCreate or fmShareExclusive);
  try
    { first file }
    Stream2 := TFileStream.Create('c:\file1', fmOpenRead or fmShareDenyNone);
    try
      Stream1.CopyFrom(Stream2, Stream2.Size);
    finally
      Stream2.Free;
    end;
    { next file }
    Stream2 := TFileStream.Create('c:\file2', fmOpenRead or fmShareDenyNone);
    try
      Stream1.CopyFrom(Stream2, Stream2.Size);
    finally
      Stream2.Free;
    end;
    { and so on }
  finally
    Stream1.Free;
  end;
end;


Solve 2:

function AppendFiles(Files: TStrings; const DestFile: string): integer;
var
  srcFS, destFS: TFileStream;
  i: integer;
  F: string;
begin
  result := 0;
  if (Files.Count > 0) and (DestFile <> '') then
  begin
    destFS := TFileStream.Create(DestFile, fmCreate or fmShareExclusive);
    try
      i := 0;
      while i < Files.Count do
      begin
        F := Files(i);
        Inc(i);
        if (CompareText(F, DestFile) <> 0) and (F <> '') then
        begin
          srcFS := TFileStream.Create(F, fmOpenRead or fmShareDenyWrite);
          try
            if destFS.CopyFrom(srcFS, 0) = srcFS.Size then
              Inc(result);
          finally
            srcFS.Free;
          end;
        end
        else
        begin
          { error }
        end;
      end;
    finally
      destFS.Free;
    end;
  end;
end;

Responding to Windows Messages

Problem/Question/Abstract:

It shows how to act on response to windows messages. Further information can be foun in the Online Help seeking  "message handling"

Answer:

It is as easy as writing a method that complies with

Getting a TMessage Parameter or a specific Message Parameter (such as TWMMouse that makes it easier to get the message's parameters)
Putting the reserved word message followed by the windows message to which you want to react (such as WM_MOUSEMOVE)

Then write your method and VOILA!

Here is the code:

unit messageUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    procedure CatchMouseMove(var winMessage: TWMMouse); message wm_mousemove;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

procedure TForm1.CatchMouseMove(var winMessage: TWMMouse);
{*
WM_MOUSEMOVE
fwKeys = wParam;        // key flags
xPos = LOWORD(lParam);  // horizontal position of cursor
yPos = HIWORD(lParam);  // vertical position of cursor
*}

begin
  self.Color := TColor(winmessage.XPos)
end;

{$R *.DFM}

end.

How to get the virtual series number of an audio CD

Problem/Question/Abstract:

How to get the virtual series number of an audio CD

Answer:

Answer 1:

Windows creates a "Virtual Series Number" for Audio CDs. You can use the following code to get the VSN of an audio CD:

type
  TNumbBase = 1..36;

function NumbToStr(Numb: LongInt; Base: TNumbBase): string;
const
  NumbDigits = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
begin
  Result := EmptyStr;
  while Numb > 0 do
  begin
    Result := NumbDigits[(Numb mod Base) + 1] + Result;
    Numb := Numb div Base;
  end;
  if Result = EmptyStr then
    Result := '0';
end;

function GetCDID(Drive: string): string;
var
  Serial: DWord;
  T: Cardinal;
begin
  if GetVolumeInformation(PChar(Drive), nil, 0, @Serial, T, T, nil, 0) then
    Result := NumbToStr(Serial, 16)
  else
    Result := EmptyStr;
end;

Drive should be the name of the root directory of your CD drive. Use it like

ShowMessage(GetCDID('I:\'));

or

ShowMessage(GetCDID('\\Computer2\\CDDrive\'));


Solve 2:

You have to use the API-call GetVolumeInformation. But first, you have to implement it correctly:


function GetVolumeInformation(lpRootPathName: PAnsiChar; lpVolumeNameBuffer: PAnsiChar; nVolumeNameSize: DWORD; var lpVolumeSerialNumber, lpMaximumComponentLength,
lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: PAnsiChar; nFileSystemNameSize: DWORD): bool; stdcall; external kernel32 name 'GetVolumeInformationA';


In your application:


function GetCDId: string;
var
  root: string;
  VolumeNameBuffer, FileSystemNameBuffer: PChar;
  VolumeSerialNumber, FileSystemFlags, MaximumComponentLength: LongInt;

  function Int2Hex(number: LongInt): string;
  var
    i: LongInt;
    s: string;
  begin
    s := '';
    i := 0;
    while number > 0 do
    begin
      i := number mod 16;
      case i of
        0..9: s := IntToStr(i) + s;
        10: s := 'A' + s;
        11: s := 'B' + s;
        12: s := 'C' + s;
        13: s := 'D' + s;
        14: s := 'E' + s;
        15: s := 'F' + s;
      end;
      number := number - i * 16;
    end;
    Result := s;
  end;

begin
  root := 'x:\'; {where X is the drive letter of your CD drive}
  VolumeNameBuffer := StrAlloc(256);
  FileSystemNameBuffer := StrAlloc(256);
  if GetVolumeInformation(PChar(root), VolumeNameBuffer, 255, VolumeSerialNumber,
    MaximumComponentLength, FileSystemFlags, FileSystemNameBuffer, 255) then
    Result := Int2Hex(VolumeSerialNumber);
else
  Result := '';
end;

How to preserve the default popup menu for a component

Problem/Question/Abstract:

Is there a way to keep the default popup menus for e.g. TMemo, TEdit if there is an explicit popup menu for the parent control?

Answer:

You have to trap the WM_CONTEXTMENU message on the level of the parent. Assuming the parent is the form you would add a message handler to the form:

{ ... }
private

procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
{ ... }

and implement it like this:

procedure TForm1.WMContextMenu(var Message: TWMContextMenu);
var
  wnd: HWND;
  ctrl: TWinControl;
begin
  if message.XPos > 0 then
  begin
    wnd := WindowFromPoint(Mouse.CursorPos);
    if wnd <> handle then
    begin
      ctrl := FindControl(wnd);
      if Assigned(ctrl) and (ctrl is TCustomEdit) then
        Exit;
    end;
  end
  else if ActiveControl is TCustomEdit then
    Exit;
  inherited;
end;

Doing the same if the parent with the menu is a panel or tabsheet or such is a bit more difficult, you have to subclass it via WindowProc, or make a descendent class to be able to trap the message.

Fill In Combo Box (Component)

Problem/Question/Abstract:

In the following article I am going to give you a simple, enhanced combo box, that fills in the text area with possible options from the items list. Simple, but useful.

Note: Delphi 6 does this by default, already

Answer:

INTRODUCTION

In this article I show you how to enhance an already existing component, easily. Because of the nature of this article you should be familar with Delphi already, however, no deep knowledge is needed.

Developing a component is, thanks to Delphi, a rather simple task. You do not have to start from scratch everytime you want to enhance something, already existing. You can simple create a new class and derive it from the one you want to enhance.

GETTING STARTED

In our case we are going to enhance the TComboBox component, directly. We could choose the TCustomComboBox, however, they have different published properties from one Delphi version to another, therefore that want make much sense.

Delphi makes the simple task of creating a new component even more simple by offering a small wizard. From the Menu File | New... select the Component right from the first tab "New."

A simple wizard will show. Fill in accordingly:


Ancestor Type: TComboBox

Class Name: TFillComboBox

Palette Page: Samples (or any you want, i took "Standard")

Unit File Name: Select a folder and file to save your work


Press OK, we will install it at a later time.

The wizard will create a basic component for you, inlcuding the installation routine shown below.

procedure Register;
begin
  RegisterComponents('Standard', [TFillComboBox]);
end;

This routine will be called by Delphi when you select install on your component package including this file. The first parameter of RegisterComponents names the palette page, where the components are installed, the second is an array of the components to be installed.

ADDING A NEW PROPERTY

To our new component we add a new property, called AutomaticFillin. When set to True we will search for a item matching the user input and add the remainder to the text box, otherwise we wont.

Therefore we have to declare one private variable that will save the value of the switch. By puting a property into the published part of the class declaration we allow the Delphi developer to change its value in the Object Inspector.

private
FAutomaticFillin: Boolean;

procedure SetAutomaticFillin(const Value: Boolean);
published
    property AutomaticFillin: Boolean
      read FAutomaticFillin
      write SetAutomaticFillin
      default True;

procedure TFillComboBox.SetAutomaticFillin(const Value: Boolean);
begin
  FAutomaticFillin := Value;
end;

THE PROCESSING OF THE USER CHANGES

In order to become notified when the user changes the text field, we have to override the default message handler for the combo box.

protected

procedure ComboWndProc(
  var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer
  ); override;

In our implementation, we check first whether the special handling is turned on. If it is turned on, we will get the current text, the user has typed, and then search for it in the items list. If we have a match, we will replace the text with the matching item and select the part added by our function.

THE CODE

If your have followed the directions from the "GETTING STARTED" section, simply replace the unit code with the following code and save your file.

unit FillComboBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFillComboBox = class(TComboBox)
  private
    FAutomaticFillin: Boolean;
    procedure SetAutomaticFillin(const Value: Boolean);
  protected
    procedure ComboWndProc(
      var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer
      ); override;
  public
  published
    constructor Create(AOwner: TComponent); override;
    property AutomaticFillin: Boolean
      read FAutomaticFillin
      write SetAutomaticFillin
      default True;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TFillComboBox]);
end;

{ TFillComboBox }

procedure TFillComboBox.ComboWndProc(
  var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer
  );
var
  I: Integer;
  CurrentText: string;
begin
  inherited ComboWndProc(Message, ComboWnd, ComboProc);
  // skip processing, if turned off
  if not FAutomaticFillin then
    Exit;
  // first check whether the backspace key was pressed, we do not fill in
  // in such case!
  if Message.Msg = WM_CHAR then
  begin
    // all characters from 32 (Space) through 127 (Upper ANSI) are matched
    if TWMChar(Message).CharCode in [$20..$7F] then
    begin
      // fill in the rest of the text
      // save the current text, the user has typed
      CurrentText := Text;
      // get the first string, matching the text partially
      I := SendMessage(Handle, CB_FINDSTRING, -1, LongInt(PChar(CurrentText)));
      if I >= 0 then
      begin
        // match found!
        // load matching text, I is the position of the matching string
        Text := Items.Strings[I];
        // select the text beyond the text typed
        SelStart := Length(CurrentText);
        SelLength := Length(Text) - Length(CurrentText);
      end;
    end;
  end;
end;

constructor TFillComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutomaticFillin := True;
end;

procedure TFillComboBox.SetAutomaticFillin(const Value: Boolean);
begin
  FAutomaticFillin := Value;
end;

end.

INSTALLING THE COMPONENT

The last step is to install the component you have just created. Go to the menu and select Component | Install Component.... Select your FillComboBox.pas in the "Unit file name" field and press "OK."

That's all. Now you can create a new application and use the component whenever you feel like.

Simple Animated Bit- and SpeedButtons

Problem/Question/Abstract:

How do I create buttons with animated bitmaps?

Answer:

One thing that's not well-known (or maybe more accurately, not too obvious) is that the glyphs used for bit buttons are actually multi-framed bitmaps arranged horizontally from left to right. The rule is that you can have up to four frames in the bitmap, with each frame representing a particular button state. What you normally see is the first frame of the bitmap displayed on the button; this glyph represents the "up" state of the button. The other frames represent other states. Here's their layout:



Figure 1 - The arrangement of a multi-framed bitmap�����������������������

Table 1 describes what each bitmap frame represents:

Frame
Button State
Description
1
Up
This frame appears when the button is unselect. If no other frames exist in the bitmap, Delphi uses this image for all other images.
2
Disabled
This frame is typically a dimmed bitmap indicating that the button is disabled and can't be selected.
3
Down
This frame appears when a button is clicked. Frame 1 then reappears when the user releases the mouse button.
4
?
I have absolutely no idea what this particular frame is used for, and the online help doesn't offer any explanations whatsoever.


Table 1 - Description of multi-image bitmap frames and when they're used

So what's the point to all this? Armed with the information I just provided, you can create simple, two-frame animations that will show a different picture based upon the up or down state of a button. Here's sample:

  (enlarged view)

The bitmap above shows a bitmap that I use for a product that I created that runs on a CD. Frame one (the leftmost bitmap) is displayed with the button is in its up position. Frame two displayes when the button is disabled, and frame three displays when the button is pressed. Notice in frame three how the logo and CD have "moved" down and to the right, and the shadow disappears. The net effect achieved here is that the logo appears to move down as the button is pressed.

So how do you construct the bitmaps? I've found that the image editor works just great. Just create a new bitmap by selecting File|New|Bitmap from the main menu. When the image properties dialog box appears on the screen, set the dimensions like so:

Give the image a height value first (Borland's standard buttons are 16-pixels high - I like mine to be more than that)
Then, set the width as 3X the height. So for instance, if you set a height of 16 pixels, your corresponding width would be 48 pixels. Pretty simple

Then all you have to do is use your imagination to create your bitmaps. Have fun!

Disable the IDE splash screen

Problem/Question/Abstract:

Disable the IDE splash screen

Answer:

Start Delphi with the parameter -ns ('no splash'):

Delphi32.EXE -ns

Also works with C++ Builder.

Change the color of a specific subitem in a TListView

Problem/Question/Abstract:

How to change the color of a specific subitem in a TListView.

Answer:

To change the color of a specific SubItem in a TListView all you have to do is to put some code in the OnCustomDrawSubItems event of the TListView. Your probably thinking of putting the OwnerDraw property of the ListView to True...
don't do this, yes I know normally it should be set to True, but in case of a TListView this is not the case...a bug somewhere in Delphi. Unlike the OnCustomDraw the OnCustomDrawSubItems event is sent no matter the state of the OwnerDraw property.

The OnCustomDrawSubItems is fired prior to drawing the SubItem on the TListView.
To alter the default drawing process at other stages (e.g. after the SubItem is drawn,... .), you must use the OnAdvancedCustomDrawSubItem event.
You can put code here to change the appeance of the SubItems, the ViewStyle of the TListView must be set to vsReport in order for this to function correctly.
Then you can use the canvas of the ListView as a drawing surface.

Let's say you want the font color of a SubItem to turn red whenever it's below is negative then put the following code in the OnCustomDrawSubItems event:


procedure TForm1.ListViewCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  //Check if the value of the third column is negative,
  //if so change it's font color to Red (clRed).
  if SubItem = 3 then
  try
    if StrToInt(Item.SubItems.Strings[SubItem - 1]) < 0 then
      Sender.Canvas.Font.Color := clRed;
  except
    on EConvertError do
      next;
  end;
end;


Used Parameters:

Sender : Specifies the ListView that owns the SubItems

Item  : Is the current Item being drawn

SubItem: Index of the SubItem of the ListItem (Item) in its SubItems property

State  : Indicates various attributes that affect the way the SubItem is drawn

DefaultDraw: Set it to False to prevent the ListView from adding the SubItem's text after the event handler exits.


Tested with Delphi 6 Professional on Windows 2000 Professional.

Create a TTreeView with a three state checkbox

Problem/Question/Abstract:

I tried many combinations of GW_STYLE with TVS_CHECKBOXES or BS_AUTO3STATE and I can't get a three state checkbox. All I have is a plain 2 state box. Any ideas?

Answer:

Actually, you can have any number of checkbox states you like. The number of the images in the state image list determines the number of the states. By default, the image list has two bitmaps: checked and unchecked. But you are always able to add yours for a third (forth ...) state. The code below shows a TTreeView with checkboxes and a third state. I've tested it on D4 and it seemed to work alright. You can set the third state to the tree node by setting 3 to the StateIndex property in the form's OnCreate event or in any other suitable place:

MyTreeView1.Items[0].StateIndex := 3;

{ ... }
type
  TMyTreeView = class(TTreeView)
  protected
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure AddNewStateImage;
  end;

  { ... }

procedure TMyTreeView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or TVS_CHECKBOXES;
end;

procedure TMyTreeView.CNNotify(var Message: TWMNotify);
begin
  with Message do
    if NMHdr^.code = NM_CUSTOMDRAW then
      AddNewStateImage;
  inherited;
end;

procedure TMyTreeView.AddNewStateImage;
var
  XImageList: TImageList;
  XImage: HIMAGELIST;
  XBitMap: TBitMap;
  i: integer;
begin
  XImage := TreeView_GetImageList(Handle, TVSIL_STATE);
  if (XImage <> 0) and (ImageList_GetImageCount(XImage) < 4) then
  begin
    XImageList := TImageList.Create(Self);
    XBitMap := TBitMap.Create;
    try
      XImageList.ShareImages := true;
      XImageList.Handle := XImage;
      XBitMap.Width := XImageList.Width;
      XBitMap.Height := XImageList.Height;
      XImageList.Draw(XBitMap.Canvas, 0, 0, 2, false);
      XImageList.Add(XBitMap, nil);
    finally
      XImageList.Free;
      XBitMap.Free;
    end;
    for i := 0 to Items.Count - 1 do
      if Items[i].StateIndex > 0 then
        Items[i].StateIndex := Items[i].StateIndex;
  end;
end;

How to create a program that deletes itself after running

Problem/Question/Abstract:

I would like to run a program that finishes by deleting itself (similar to the DOS TSR programs). Is this possible?

Answer:

Solve 1:

One technique is to use a batch file. It works on all versions of Windows. An example:

{ ... }
s := 'SelfDelete.bat';
s := ExtractFilePath(ParamStr(0)) + s;
assign(f, s);
rewrite(f);
writeln(f, ':f');
writeln(f, 'del "' + ParanStr(0));
writeln(f, 'if EXIST "' + ParamStr(0) + '" goto f');
writeln(f, 'del "' + s);
closefile(f);
WinExec(PChar(s), SW_HIDE)


Solve 2:

This simple method uses a Windows Registry entry, which in turn, makes Command.com to do the job for us, whenever the next Windows restart occurs. Add the following code to a procedure of your choice:

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
    Registry;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  APath: array[0..255] of char;
begin
  {Command.com does not support long paths, so convert to short}
  if GetShortPathName(PChar(ParamStr(0)), APath, SizeOf(APath) - 1) <> 0 then
  begin
    {Work with TRegistry}
    with TRegistry.Create do
    try
      {Set Root Key}
      RootKey := HKEY_LOCAL_MACHINE;
      {Open Key, creating key if it does not exist}
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\RunOnce', True) then
      begin
        {Add our String Value to the Key}
        WriteString('MyApp', 'command.com /c del ' + APath);
        {Close the Key}
        CloseKey;
      end;
    finally
      {Free TRegistry}
      free;
    end;
  end;
end;

This example makes use of ParamStr(0) to meet the expectations that the title of this article has elicited: By pointing to the path + filename of the application that executes this procedure, the program will in fact bring about the removal of itself. Windows NT/2000 Note: Users running programs that utilize this code, must have the right to modify the HKEY_LOCAL_MACHINE section of the Windows Registry.


Solve 3:

Try this (not tested under WinXP, but works under Win95, Win98, WinNT 4.0 and Win2000):

procedure DeleteExeAndDir;
var
  hModule: THandle;
  szModuleName, szDirName: array[0..MAX_PATH] of Char;
  hKrnl32: THandle;
  pExitProcess, pDeleteFile, pFreeLibrary, pUnmapViewOfFile, pRemoveDir: pointer;
  ExitCode: UINT;
var
  r: integer;
begin
  hModule := GetModuleHandle(nil);
  GetModuleFileName(hModule, szModuleName, sizeof(szModuleName));
  StrPCopy(szDirName, ExtractFileDir(szModuleName));
  hKrnl32 := 'kernel32');
pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
pDeleteFile := GetProcAddress(hKrnl32, 'DeleteFileA');
pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
pUnmapViewOfFile := GetProcAddress(hKrnl32, 'UnmapViewOfFile');
pRemoveDir := GetProcAddress(hKrnl32, 'RemoveDirectoryA');
ExitCode := system.ExitCode;
SetCurrentDirectory(pchar(ExtractFileDir(szDirName)));
if ($80000000 and GetVersion()) <> 0 then
  {Win95, 98, Me}
  asm
    lea     eax, szModuleName
    lea     ecx, szDirName
    push    ExitCode
    push    0
    push    ecx
    push    pExitProcess
    push    eax
    push    pRemoveDir
    push    hModule
    push    pDeleteFile
    push    pFreeLibrary
    ret
  end
else
begin
  for r := 1 to 100 do
  begin
    CloseHandle(r shl 2);
  end;
  {CloseHandle(THANDLE(4));}
  asm
    lea     eax, szModuleName
    lea     ecx, szDirName
    push    ExitCode
    push    0
    push    ecx
    push    pExitProcess
    push    eax
    push    pRemoveDir
    push    hModule
    push    pDeleteFile
    push    pUnmapViewOfFile
    ret
  end
end;
end;


Solve 4:

program delself;

uses
  windows;

procedure DeleteSelf;
var
  module: HMODULE;
  buf: array[0..MAX_PATH - 1] of char;
  p: ULONG;
  hKrnl32: HMODULE;
  pExitProcess, pDeleteFile, pFreeLibrary: pointer;
begin
  module := GetModuleHandle(nil);
  GetModuleFileName(module, buf, sizeof(buf));
  CloseHandle(THandle(4));
  p := ULONG(module) + 1;
  hKrnl32 := GetModuleHandle('kernel32');
  pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
  pDeleteFile := GetProcAddress(hKrnl32, 'DeleteFileA');
  pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
  asm
    lea eax, buf
    push 0
    push 0
    push eax
    push pExitProcess
    push p
    push pDeleteFile
    push pFreeLibrary
    ret
  end;
end;

begin
  DeleteSelf;
end.

How to connect a TRadioGroup to a TCheckListBox

Problem/Question/Abstract:

I have a form that contains a radio groupbox with 4 items associated with it and a checklistbox with 4 items as well. In this case the radio box dictates which items in a checklistbox can be selected. For example, if the radio groupbox is set to item 3, that means only the first 3 items in the checklistbox can be selected. Therefore, if the user changes the radiobox setting to the second item, only the first 2 selections in the checklistbox are allowed to be marked and the third item that was previously checked should be cleared.

Answer:

procedure MyProc(RadioBoxSender: TRadioGroup; CheckListBoxSender: TCheckListBox);
var
  I: Integer;
begin
  with CheckListBoxSender do
    for i := 1 to 3 do { no need to do 0}
      if i > RadioBoxSender.ItemIndex then
        checked[i] := false;
end;

How to save items of a TComboBox to an ini file

Problem/Question/Abstract:

How to save items of a TComboBox to an ini file

Answer:

This is one possibility. It will put the items in a seperate section:

procedure TForm1.WriteComboToIni;
var
  IniFile: TIniFile;
  Cnt: integer;
begin
  IniFile := TIniFile.Create('c:\test.ini');
  try
    with ComboBox1 do
      if Items.Count > 0 then
        for Cnt := 0 to Items.Count - 1 do
          IniFile.WriteString('Section', 'Items' + IntToSTr(Cnt), Items[Cnt]);
  finally
    IniFile.Free;
  end;
end;

Outlook Automation - Contactlist

Problem/Question/Abstract:

How use Outlook's Contact list in Applications

Answer:

This is sample how look and change information in Outlook's Contactlist from external application.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
const
  // constants from MSOUTL8.olb

  olByValue = 1;
  olByReference = 4;
  olEmbeddedItem = 5;
  olOLE = 6;

  olMailItem = 0;
  olAppointmentItem = 1;
  olContactItem = 2;
  olTaskItem = 3;
  olJournalItem = 4;
  olNoteItem = 5;
  olPostItem = 6;

  olFolderDeletedItems = 3;
  olFolderOutbox = 4;
  olFolderSentMail = 5;
  olFolderInbox = 6;
  olFolderCalendar = 9;
  olFolderContacts = 10;
  olFolderJournal = 11;
  olFolderNotes = 12;
  olFolderTasks = 13;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    mName: TMemo;
    mFamily: TMemo;
    mFullName: TMemo;
    mCompany: TMemo;
    mSaveAs: TMemo;
    mBody: TMemo;
    btnSave: TButton;
    sbContacts: TScrollBar;
    btnConnect: TButton;
    procedure btnConnectClick(Sender: TObject);
    procedure mNameChange(Sender: TObject);
    procedure sbContactsChange(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    { Private declarations }
    IsDirty: boolean;
  public
    { Public declarations }
    OlApp, Namespace, ContactFolder: OleVariant;
    procedure LoadContact(I: Integer; folder: OleVariant);
    procedure SaveContact(I: Integer; folder: OleVariant);
  end;

var
  Form1: TForm1;

implementation
uses ComObj;
{$R *.DFM}

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  OlApp := CreateOleObject('Outlook.Application');
  Namespace := OlApp.GetNameSpace('MAPI');
  ContactFolder := Namespace.GetDefaultFolder(olFolderContacts);
  sbContacts.Max := ContactFolder.Items.Count;
  sbContacts.Position := 1;
  LoadContact(1, ContactFolder);
end;

procedure TForm1.LoadContact(I: Integer; folder: OleVariant);
var
  Item: OleVariant;
begin
  Caption := 'Rec ' + IntToStr(i) + ' from ' + IntToStr(sbContacts.Max);
  Item := folder.Items(I);
  mName.Text := Item.FirstName;
  mFamily.Text := Item.LastName;
  mFullName.Text := Item.FullName;
  mCompany.Text := Item.CompanyName;
  mSaveAs.Text := Item.FileAs;
  mBody.Text := Item.Body;
end;

procedure TForm1.SaveContact(I: Integer; folder: OleVariant);
var
  Item: OleVariant;
begin
  Item := folder.Items(I);
  Item.FirstName := mName.Text;
  Item.LastName := mFamily.Text;
  Item.FullName := mFullName.Text;
  Item.CompanyName := mCompany.Text;
  Item.FileAs := mSaveAs.Text;
  Item.Body := mBody.Text;
  Item.Save;
  isDirty := False;
end;

procedure TForm1.mNameChange(Sender: TObject);
begin
  IsDirty := True;
end;

procedure TForm1.sbContactsChange(Sender: TObject);
begin
  LoadContact(sbContacts.Position, ContactFolder);
end;

procedure TForm1.btnSaveClick(Sender: TObject);
begin
  SaveContact(sbContacts.Position, ContactFolder);
end;

end.

How to save the font settings of a control to the registry

Problem/Question/Abstract:

How can I save the font settings of a control to registry? Saving name , size, etc. as string/int doesn't seem the best way ... (as far as I remember , I can't even save all font options this way)

Answer:

You can create a little component (needs not be installed on the palette) that allows you to stream a fonts properties to a stream. The stream contents could then be saved to a binary key in the registry.


{ ... }
type
  TFontWrapper = class(TComponent)
  private
    FFont: TFont;
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetFont(value: TFont);
  published
    property Font: TFont read FFont write SetFont;
  end;

  { TFontWrapper }

constructor TFontWrapper.Create(aOwner: TComponent);
begin
  inherited;
  FFont := TFont.Create;
end;

destructor TFontWrapper.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TFontWrapper.SetFont(value: TFont);
begin
  FFont.Assign(value);
end;

{ ms is a field of the form }

procedure TForm1.Button1Click(Sender: TObject);
var
  helper: TFontWrapper;
begin
  if not Assigned(ms) then
    ms := TMemoryStream.Create
  else
    ms.Clear;
  helper := TFontWrapper.Create(nil);
  try
    helper.font := label1.font;
    ms.WriteComponent(helper);
  finally
    helper.free;
  end;
  label1.font.size := label1.font.size + 2;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  helper: TFontWrapper;
begin
  if not Assigned(ms) then
    Exit;
  ms.Position := 0;
  helper := TFontWrapper.Create(nil);
  try
    ms.ReadComponent(helper);
    label1.font := helper.font;
  finally
    helper.free;
  end;
end;


If reg is a TRegistry instance already with key open a


reg.WriteBinaryData(valuename, ms.Memory^, ms.Size);


would save the streamed data to the registry,


ms.size := reg.GetDatasize(valuename);
reg.ReadBinaryData(valuename, ms.Memory^, ms.Size);


would read it back. Mind the caret!

Application Settings (article 1)

Problem/Question/Abstract:

Managing Application Settings

Answer:

Introduction

Almost every program we write these days has a set of application settings, commonly called Program Options, that needs to be managed. Typically, the application needs to be able to save and restore these options to the registry and display them to the user for modification. Most developers simply create a unit to hold these option settings as a set of a global variables, or as a properties of a global application settings object.

The problem with this approach is that a lot of tedious code is required in order to save and load these settings. Additional code is then required to display these settings to the end user and allow the user to modify them as required. For example, you've probably written code like this many times before:

procedure TForm1.LoadSettings;
begin
  cbWordWrap.Checked := Settings.WordWrap;
  edFontName.Text := Settings.FontName;
end;

procedure TForm1.SaveSettings;
begin
  Settings.WordWrap := cbWordWrap.Checked;
  Settings.FontName := edFontName.Text;
end;

The purpose of this article is to demonstrate an alternative way to manage application settings by taking advantage of RTTI, Run Time Type Information. In part 1 of this article, we talk about creating a basic application settings object that will automatically save and load itself to and from the registry. In part 2, we will create an object dataset that enables you to connect this application settings object to data aware controls, thereby eliminating the tedious code above.

RTTI 101

The goal of part 1 is to create an application settings object that can save and load itself to and from the registry automatically. For those of you familiar with RTTI, this part may seem to be quite trivial, however for those of you new to RTTI, the very concept of RTTI can seem somewhat magical. Thus the first thing we should do is briefly cover RTTI, what it is and how it works. This will not be an in depth discussion of RTTI, but will hopefully be sufficient for the purpose of this article. Note that the best discussion of RTTI is in Ray Lischners book, Secrets of Delphi 2.

RTTI is a mechanism provided by Delphi that describes the published properties of an object. It provides a means for third party code to be able to interact with objects even though this code has no intimate knowledge of the objects. The object inspector in Delphi is a great example of RTTI in action. Have you ever wondered how the object inspector is able to display all published properties of any component even though it obviously has no intimate knowledge of the component it is displaying. The answer is RTTI. By using RTTI the object inspector is able to list all of the properties of a component and what the current values of those properties are. By again using RTTI, the object inspector is able to allow an end user, the Delphi developer in this case, to change the values of those properties as desired.

RTTI functionality is encapsulated in the VCL unit TypInfo.pas. This unit is not documented, however you can find it in your VCL/Source directory. Starting with Delphi 5, Borland added a significant number of easy access RTTI methods to TypInfo.pas in an effort to make using RTTI easier.

I have include a small RTTI utility unit called GXRTTI.pas with the code of this article. Let's take a look at one of those routines to get an idea of how we can use RTTI.

function GetPropName(Instance: TPersistent; Index: Integer): string;
var
  PropList: PPropList;
  PropInfo: PPropInfo;
  Data: PTypeData;
begin
  Result := '';
  Data := GetTypeData(Instance.Classinfo);
  GetMem(PropList, Data^.PropCount * Sizeof(PPropInfo));
  try
    GetPropInfos(Instance.ClassInfo, PropList);
    PropInfo := PropList^[Index];
    Result := PropInfo^.Name;
  finally
    FreeMem(PropList, Data^.PropCount * Sizeof(PPropInfo));
  end;
end;

The function above returns a property name for a given object at a given index in the list of published properties for that object. For example, Name might be the first property of TListBox. Thus calling GetPropName(ListBox1,0) would return the string "Name".

This function works by first getting the type data for the given instance using the GetTypeData function in TypInfo.pas. Once we have the type data, we can then retrieve a list of properties for this class. Note that you must allocate memory to hold this property list as above. Once we have the list of properties in the PropList pointer, it's easy to retrieve the property name of a given property.

Creating a Base Application Settings Object

Now that we understand a bit more about RTTI, let's take a look at creating our base application settings object. The intent is that we should be able to derive a project specific settings object from the base settings object. For example we might have a base object called TGXAppSettings and for a word processor app we might create a TWordAppSettings class to hold the specific options for this project. The TWordAppSettings object descends from TAppSettings. The point of creating a base class TGXAppSettings is that the base class will contain all of the logic needed to load and save itself to and from the registry, regardless of the properties we add to descendant classes. Thus if we added a published WordWrap property to the TWordAppSettings class, the code in the base TAppSettings class will automatically save and load the new WordWrap property forcing the developer to add any new code.

Thus in a nutshell the purpose of the base object is to provide a mechanism to automatically save and load itself to the registry, regardless of what properties are added in descendant classes. So let's take a look at the type declaration of our TGXAppSettings object.

type
  TGXAppSettings = class(TComponent)
  private
    FRegistryKey: string;
    FIgnoreProperty: TStrings;
    FAutoLoad: Boolean;
    procedure SetIgnoreProperty(Value: TStrings);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SaveToRegistry; virtual;
    procedure LoadFromRegistry; virtual;
    procedure Assign(Source: TPersistent); override;
    property IgnoreProperty: TStrings read FIgnoreProperty write SetIgnoreProperty;
  published
    property AutoLoad: Boolean read FAutoLoad write FAutoLoad;
    property RegistryKey: string read FRegistryKey write FRegistryKey;
  end;

Note that the object descends from TComponent rather then TPersistent as might be expected. I do this because I want to be able to place the project specific setting objects that will descend from TGXAppSettings on the component palette in order to drop them on a form. This feature will be used when I present the object dataset in Part 2.

As we can see above there are actually very few methods in the base TGXAppSettings object. There is a SaveToRegistry method to save the object to the registry and a LoadFromRegistry method to load it from the registry. We have also overriden the assign method in order to write code to enable us to easily copy one settings object to another.

Next two properties have been added, AutoLoad and RegistryKey. AutoLoad specifies where or not the component automatically loads itself from the registry when Delphi has loaded a form the component is sitting on. It also tells the component to save itself back to the registry automatically when it is being destroyed. The property called RegistryKey has been added to enable the developer to specify where to save and load the object in the registry.

The Constructor and Destructor have been overriden to allow us to create the IgnoreProperty stringlist. The IgnoreProperty stringlist is used to instruct the class of which properties to ignore when writing properties out to the registry. Descendant setting classes should not have to utilize this feature as it is primarily intented to prevent the AutoLoad, RegistryKey, Name and Tag properties from being written to the Registry.

Finally, the Loaded method has been overriden to give the component the chance to load itself from the registry if the AutoLoad property is set to true.

SaveToRegistry and LoadToRegistry Method

The SaveToRegistry method contains the code needed to save the object to the registry. It uses RTTI to automatically save all published properties of the object to the registry. Now you might be think what's the point of saving the published properties since this object doesn't have any published properties. While it is true that this object has no published properties, application setting objects that descend from this base class will have published properties and this method will save those properties auto-magically (to use my favourite term).

Here is the code for SaveToRegistry:

procedure TGXAppSettings.SaveToRegistry;
var
  Registry: TRegistry;
  Index: Integer;
  PropName: string;
  MStream: TMemoryStream;
begin
  if RegistryKey = '' then
    exit;
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    Registry.OpenKey(RegistryKey, True);
    for Index := 0 to GetPropCount(Self) - 1 do
    begin
      PropName := GetPropName(Self, Index);
      if (FIgnoreProperty.Indexof(Propname) >= 0) then
        Continue;
      case PropType(Self, GetPropName(Self, Index)) of
        tkLString, tkWString, tkString: Registry.WriteString(PropName,
          GetStrProp(Self, PropName));
        tkChar, tkEnumeration, tkInteger: Registry.WriteInteger(PropName,
          GetOrdProp(Self, PropName));
        tkInt64: Registry.WriteString(PropName, IntToStr(GetInt64Prop(Self,
          PropName)));
        tkFloat: Registry.WriteString(PropName, FloatToStr(GetFloatProp(Self,
          PropName)));
        tkClass:
          begin
            if (TPersistent(GetOrdProp(Self, PropName)) is TStrings) then
            begin
              MStream := TMemoryStream.Create;
              try
                TStrings(GetOrdProp(Self, PropName)).SaveToStream(MStream);
                Registry.WriteBinaryData(PropName, MStream.Memory^, MStream.Size);
              finally
                MStream.Free;
              end;
            end;
          end;
      end;
    end;
  finally
    Registry.Free;
  end;
end;

In the code above, we first open the registry at the desired key. We then iterate through each property of the settings object and write it out to the registry. The function GetPropCount is a utility function in GXRTTI.pas that returns the number of published properties in a given object. As we go through each property, we first get the property name using the GetPropName function in GXRTTI.pas. Finally, dependant on the type of property, we write the property out to the registry using the appropriate registry function. Functions like GetStrProp and GetOrdProp retrieve the value of the given property and are contained in the unit TypeInfo.pas.

For properties based on TStrings, we retrieve a pointer to the TStrings object using GetOrdProp and write it to the registry using WriteBinaryData. A similar technique could be used for TPicture based properties if you wished to add this feature to the class.

The LoadToRegistry method is almost identical, except the reverse functionality is performed. I won't show it here, however you can see it in the downloable code at the end of this article.

Assign method

We override the assign method in order to enable us to copy one application settings object to another. This will let us create a temporary application settings object the user can edit. We need this capability so that if the user hits the cancel button, the changes the user made are thrown away with the temporary application settings object.

The assign method appears as such:

procedure TGXAppSettings.Assign(Source: TPersistent);
begin
  if Source is Self.ClassType then
    CloneClass(Source, Self)
  else
    inherited Assign(Source);
end;

This method is deceptively simple, however note the call to CloneClass. This routine is in GXRTTI.pas and it copies all published properties from one class to another by using RTTI.

An Example Project

Now that we have done all of that work, let's create an example to see how this all fits together. I've copied the code from Borland's Richedit demo and added an options dialog to the project in order to see how this works. Our rich edit settings class appears as follows:

type
  TRichEditSettings = class(TGXAppSettings)
  private
    FWordWrap: Boolean;
    FFontName: string;
    FFontSize: Integer;
  public
    procedure UpdateSettings(Editor: TRichEdit);
  published
    property FontName: string read FFontName write FFontName;
    property FontSize: Integer read FFontSize write FFontSize;
    property WordWrap: Boolean read FWordWrap write FWordWrap;
  end;

As we see above, three properties have been added. These properties are the options for the Richedit application.

Next, I added one method called UpdateSettings. I use this method to apply the options to the actual application. In this example, the application passes the richedit control to the method that it desires to have the application settings applied to. How you apply option settings to the project will vary considerably from project to project and it is entirely up to you to decide on the best way to do this. The UpdateSettings method appears as follows:

procedure TRichEditSettings.UpdateSettings(Editor: TRichedit);
begin
  Editor.WordWrap := WordWrap;
  Editor.DefAttributes.Name := FontName;
  Editor.DefAttributes.Size := FontSize;
end;

Now that we have created our TRichEditSettings component, we need to integrate it into the application which as we will see, could not be any easier. The first thing we do is create a project specific package, GXRichEdit.dpk. We add the unit GXProjSt.pas which contains our TRichEditSettings class. We then compile and install the package, thereby adding the TRichEditSettings component to the component palette.

Once we have the TRichEditSettings component on the palette, we simply drop it on the main form. We set the RegistryKey property to where we want to save the settings in the registry. Next we set the FontName, FontSize and WordWrap properties to the desired default values. Here are the property values as set in the example code.



The beauty of this approach is that it leverages RAD development techniques to minimize the hassle of dealing with application settings. If at some point in the future, you need to add a new setting, simply define a new property in TRichEditSettings and recompile the package. You can then use the object inspector to set the default value of the new setting.

This concludes Part 1 of how to manage application settings, in Part 2 we will see how we can connect the RichEditSettings component to an object dataset to enable the user to quickly and easily change application settings.

Limitations

The code I have presented above has a few limitations that you should be aware of before applying it in your own projects. The major limitation is that class properties other then TStrings is not currently supported. Adding support for TPicture is relatively easy but TFont is more difficult primarly due to the limitations of the object dataset presented in Part 2.

The code presented in this article has not been tested in a production environment, buyer beware.

Code

Download the code from this article here. Please be sure to read Install.txt included in the zip file before opening the project in Delphi.

Show the buffer contents of the GetLogicalDriveStrings function in a TMemo

Problem/Question/Abstract:

How to show the buffer contents of the GetLogicalDriveStrings function in a TMemo

Answer:

procedure GetLogicalDrives(aList: TStrings);
var
  buff: PChar;
  size, i, j: DWORD;
begin
  {first we get the number of bytes required}
  j := GetLogicalDriveStrings(0, PChar(@j));
  size := j;
  Getmem(buff, size);
  try
    j := GetLogicalDriveStrings(size, buff);
    for i := 0 to j - 1 do
      if (buff[i] = #0) then
        buff[i] := #13;
    aList.text := buff;
  finally
    Freemem(buff, size);
  end;
end;