Decrementing a datetime field in Paradox

Problem/Question/Abstract:

Decrementing a datetime field in Paradox

Answer:

There is a bug in Local SQL on Paradox:

Executing an Update statement on a Paradox table where '1' is being subtracted in a datetime field does not subtract '1', but rather adds '1'.

// this will ADD one!
UPDATE SAMPLE.DB set DT = DT - 1

// the following workaround will give the correct result:
UPDATE SAMPLE.DB set DT = DT + (-1)

Jumping between compiler errors

Problem/Question/Abstract:

Jumping between compiler errors

Answer:

After compiling, when there were errors found:

Alt-F8 will take you to the next compiler error

Alt-F7 will take you to the previous error.

Add a page break to an Excel worksheet

Problem/Question/Abstract:

How to add a page break to an Excel worksheet

Answer:

If WS is your worksheet:

{ ... }
Excel.ActiveWindow.View := xlPageBreakPreview;
WS.HPageBreaks.Add(WS.Cells.Item[78, 1]);
{ ... }

How to hide the font size list in a TFontDialog

Problem/Question/Abstract:

How can I completely hide the fontsize selection combobox in the font dialog? I have manipulated some properties of the fontdialog but the combobox where you pick the font size is always visible. Furthermore, I want to keep the preview of the font but with a fixed font size.

Answer:

Set the fdLimitSize option in the dialogs Options to true and specifiy the same size for the MinFontsize and Maxfontsize property.

Hide the font size list. This requires a bit of spy work to determine the control IDs in the dialog. Once this has been done you can attach a handler to the fontdialogs Onshow handler:

procedure TForm1.FontDialog1Show(Sender: TObject);
begin
  EnableWindow(GetDlgItem(fontdialog1.handle, 1138), false);
  EnableWindow(GetDlgItem(fontdialog1.handle, 1090), false);
  ShowWindow(GetDlgItem(fontdialog1.handle, 1138), SW_HIDE);
  ShowWindow(GetDlgItem(fontdialog1.handle, 1090), SW_HIDE);
end;

1138 is the handle of the font size combobox (it is a combobox, despite looking like an edit with a list box below it), 1090 the text label above it. Without disabling the controls the accelerator for the size box will close the dialog for some reason.

For the future: the spy works done here was performed this way:

procedure TForm1.Button1Click(Sender: TObject);
begin
  fontdialog1.execute;
end;

function EnumProc(wnd: HWND; lines: TStrings): BOOL; stdcall;
var
  buf, caption: array[0..255] of char;
begin
  result := True;
  GetClassname(wnd, buf, 256);
  GetWindowText(wnd, caption, 256);
  lines.add(format('ID: %d, class: %s, caption: %s', [GetDlgCtrlID(wnd), buf,
    caption]));
end;

procedure TForm1.FontDialog1Show(Sender: TObject);
begin
  memo1.clear;
  EnumChildWindows(fontdialog1.handle, @EnumProc, integer(memo1.lines));
end;

{Output in memo:

ID: 1088, class: Static, caption: Schrift&art:
ID: 1136, class: ComboBox, caption: MS Sans Serif
ID: 1000, class: ComboLBox, caption:
ID: 1001, class: Edit, caption: MS Sans Serif
ID: 1089, class: Static, caption: &Schriftschnitt:
ID: 1137, class: ComboBox, caption: Standard
ID: 1000, class: ComboLBox, caption:
ID: 1001, class: Edit, caption: Standard
ID: 1090, class: Static, caption: &Grad:
ID: 1138, class: ComboBox, caption: 8
ID: 1000, class: ComboLBox, caption:
ID: 1001, class: Edit, caption: 8
ID: 1, class: Button, caption: OK
ID: 2, class: Button, caption: Abbrechen
ID: 1026, class: Button, caption: �&bernehmen
ID: 1038, class: Button, caption: &Hilfe
ID: 1072, class: Button, caption: Darstellung
ID: 1040, class: Button, caption: &Durchgestrichen
ID: 1041, class: Button, caption: &Unterstrichen
ID: 1091, class: Static, caption: &Farbe:
ID: 1139, class: ComboBox, caption: Schwarz
ID: 1073, class: Button, caption: Muster
ID: 1092, class: Static, caption: AaBbYyZz
ID: 1093, class: Static, caption:
ID: 1094, class: Static, caption: S&chrift:
ID: 1140, class: ComboBox, caption: Western
}

Retreive information from a TDBGrid onCellClick

Problem/Question/Abstract:

How to retreive the information from a TDBGrid when you click a cell or row

Answer:

While you click a TDBGrid row, the information can be obtained by the following procedure:

DBAccounts is a TDBGrid
For this example e_F0..e_F2 are TEdit but it can be any object
You can use FieldCount to obtain the number of fields so you can fill an array like

for x = 0 to DBAccounts.FieldCount - 1 do
  AnyArray[x] := DBAccounts.Fields[x].DisplayText

For this Example, Set TDBGrid.Options[dgRowSelect] so when you click a cell the row will be selected. Trim Function removes spaces (OPTIONAL)

procedure TForm4.DBAccountsCellClick(Column: TColumn);
begin
  with DBAccounts.SelectedField do
  begin
    e_F0.Text := Trim(DBAccounts.Fields[0].DisplayText);
    e_F1.Text := Trim(DBAccounts.Fields[1].DisplayText);
    e_F2.Text := Trim(DBAccounts.Fields[2].DisplayText);
    // and so on ....
    //.
    //.
    //.
  end;
end;

How to move icons between TImageLists

Problem/Question/Abstract:

How to move icons between TImageLists

Answer:

procedure TForm1.Button1Click(Sender: TObject);
var
  ico: TIcon;
begin
  ico := TIcon.Create;
  try
    Imagelist1.GetIcon(0, ico);
    Imagelist2.AddIcon(ico);
  finally
    ico.Free;
  end;
end;

Create a sorted TList that holds integers

Problem/Question/Abstract:

How can I create a TStringlist cousin which holds integers rather than strings. I need the ability to keep a list of objects sorted by an integer with full binary IndexOf.

Answer:

Use a TList, and do casts where appropriate:

To write:

MyList.Add(Pointer(17));
MyList.Add(Pointer(39));

To read:

MyInt := Integer(MyList[0]);

To sort:

procedure CompareInts(Item1, Item2: Pointer): Integer;
begin
  if Integer(Item1) > Integer(Item2) then
    Result := 1
  else if if Integer(Item1) < Integer(Item2) then
    Result := -1
  else
    Result := 0;
end;
{ ... }
MyList.Sort(CompareInts);

How to create a message box with your own icon

Problem/Question/Abstract:

The message box has limited icons as set by Microsoft. I would like to use one of the icon I have and insert it into the message box. Is there a way to do that? Do I have to create a component to handle it?

Answer:

function CustMsgBox(const AMsg, ACaption, BCap1, BCap2, BCap3: string;
  IconInd: integer; FocusInd: byte; Mainform: TForm): integer;
const
  Userexe: array[0..9] of char = 'user.exe';
const
{$IFDEF Win32}
  BHeight = 23;
{$ELSE}
  BHeight = 25;
{$ENDIF}
  BWidth = 77;
var
  W: TForm;
  lCaption: TLabel;
  But1, But2, But3: TButton;
  i1: integer;
  Image1: TImage;
  IHandle: THandle;
  P1: array[byte] of char;
  Textsize: TSize;
  MDC: hDC;
  CurMetrics: TTextMetric;
  Curfont: HFont;
  Msgrect: TRect;
begin
  W := TForm.CreateNew(Application);
  But2 := nil;
  But3 := nil;
  try {set up form}
    W.BorderStyle := bsDialog;
    W.Ctl3D := True;
    W.Width := 360;
    W.Height := 160;
    W.Caption := ACaption;
    W.Font.Name := 'Arial' {Mainform.Font.Name};
    W.Font.CharSet := BALTIC_CHARSET;
    W.Font.Size := Mainform.Font.Size;
    W.Font.Style := Mainform.Font.Style;
    {Get text extent}
    for i1 := 0 to 25 do
      P1[i1] := Chr(i1 + Ord('A'));
    for i1 := 0 to 25 do
      P1[i1 + 26] := Chr(i1 + Ord('a'));
    GetTextExtentPoint(W.Canvas.Handle, P1, 52, Textsize);
    {Get line height}
    MDC := GetDC(0);
    CurFont := SelectObject(MDC, W.Font.Handle);
    GetTextMetrics(MDC, CurMetrics);
    SelectObject(MDC, CurFont);
    ReleaseDC(0, MDC);
    {Set icon}
    Image1 := TImage.Create(W);
    StrPCopy(P1, ParamStr(0));
    if Image1 <> nil then
    begin
      Image1.Width := Image1.Picture.Icon.Width;
      Image1.Height := Image1.Picture.Icon.Height;
      Image1.Left := 20;
      Image1.Top := Textsize.CY + (Textsize.CY div 2);
      Image1.Width := 32;
      Image1.Height := 32;
      Image1.Parent := W;
      Image1.Name := 'Image';
      {get icon index}
      case IconInd of
        16: IHandle := ExtractIcon(hInstance, userexe, 3);
        32: IHandle := ExtractIcon(hInstance, userexe, 2);
        48: IHandle := ExtractIcon(hInstance, userexe, 1);
        64: IHandle := ExtractIcon(hInstance, userexe, 4);
        128: IHandle := ExtractIcon(hInstance, userexe, 0);
        256: IHandle := ExtractIcon(hInstance, userexe, 5);
        512: IHandle := ExtractIcon(hInstance, userexe, 6);
      else
        IHandle := ExtractIcon(hInstance, P1, IconInd);
      end;
      if IHandle <> 0 then
        Image1.Picture.Icon.Handle := IHandle
      else
        Image1.Picture.Icon := Application.Icon;
    end;
    SetRect(MsgRect, 0, 0, Screen.Width div 2, 0);
    DrawText(W.Canvas.Handle, PChar(AMsg), -1, MsgRect, DT_CALCRECT or DT_WORDBREAK);
    {set up label}
    lCaption := TLabel.Create(W);
    lCaption.Parent := W;
    lCaption.Left := 72;
    lCaption.Top := Image1.Top;
    lCaption.Width := Msgrect.Right;
    LCaption.Height := Msgrect.Bottom;
    lCaption.Autosize := False;
    lCaption.WordWrap := True;
    {Adjust form width...must do here to accommodate buttons}
    W.Width := lCaption.Left + lCaption.Width + 30;
    lCaption.Caption := AMsg;
    {buttons}
    But1 := TButton.Create(W);
    But1.Parent := W;
    But1.Caption := BCap1;
    But1.ModalResult := 1;
    if BCap2 <> '' then
    begin
      But2 := TButton.Create(W);
      But2.Parent := W;
      But2.Caption := BCap2;
      But2.ModalResult := 2;
      if BCap3 <> '' then
      begin
        But3 := TButton.Create(W);
        But3.Parent := W;
        But3.Caption := BCap3;
        But3.ModalResult := 3;
      end;
    end;
    {Set button positions}
    {set height depending on whether icon or message is tallest}
    if lCaption.Height > Image1.Height then
      But1.Top := (lCaption.Top + lCaption.Height + 20)
    else
      But1.Top := (Image1.Top + Image1.Height + 20);
    But1.Width := BWidth;
    But1.Height := BHeight;
    if But2 <> nil then
    begin
      But2.Height := BHeight;
      But2.Width := BWidth;
      But2.Top := But1.Top;
      if But3 <> nil then
      begin
        But3.Top := But1.Top;
        But3.Width := BWidth;
        But3.Height := BHeight;
        But3.Left := (W.Width div 2) + ((BWidth div 2) + 8);
        But2.Left := (W.Width div 2) - (BWidth div 2);
        But1.Left := (W.Width div 2) - ((BWidth div 2) + BWidth + 8);
        But3.Cancel := True;
      end
      else
      begin
        But2.Left := (W.Width div 2) + 4;
        But1.Left := (W.Width div 2) - (BWidth + 4);
      end;
    end
    else
    begin
      But1.Left := (W.Width div 2) - (BWidth div 2);
    end;
    {set focus}
    case FocusInd of
      3:
        if BCap3 <> '' then
          But3.Default := True;
      2:
        if BCap2 <> '' then
          But2.Default := True;
    else
      But1.Default := True;
    end;
    {Set clientheight to proper height}
    W.ClientHeight := But1.Top + But1.Height + Textsize.CY;
    { Left := (W.ClientWidth div 2) - (((OKButton.Width * 2) + 10) div 2) }
    {Show messagebox}
    {Set position}
    { Position := poScreenCenter;  }
    W.Left := Mainform.Left + ((Mainform.Width - W.Width) div 2);
    W.Top := Mainform.Top + ((Mainform.Height - W.Height) div 2);
    W.ShowModal;
    Result := W.ModalResult;
  finally
    W.Free;
  end;
end;

How to draw colored text on a TStatusBar

Problem/Question/Abstract:

How to draw colored text on a TStatusBar

Answer:

The status bar is a standard Windows control, and as such, displays the font in the clBtnText value, which is set via the Control Panel. This color is black by default, but it can vary due to the user's color scheme. Other standard Windows controls, such as buttons, exhibit this identical behavior. The StatusBar and its associated panels have an owner-draw capability that allow you to draw text in any colors you want. Be sure to change the Style property of the TStatusBar.Panels to OwnerDraw.

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = StatusBar.Panels[0] then
  begin
    StatusBar.Canvas.Font.Color := clRed;
    StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')
  end
  else
  begin
    StatusBar.Canvas.Font.Color := clGreen;
    StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');
  end;
end;

Add a bitmap to a menu item (2)

Problem/Question/Abstract:

How to add bitmaps to a menu?

Answer:

Create a Picture. Load a .BMP from somewhere into the picture. Better have the picture as a resource and load the handle with LoadBitmap(). Use the SetMenuItemBitmaps API call to connect the Picture to the Menu.

All this can by coded in the .Create of a form.

Don't use a bitmap that is too large :) because only the right-top of the bitmap is displayed.


var
  Bmp1: TPicture;
  CheckedHandle,
    Bmp1Handle: THandle;

// ... in the FormCreate event:

// either load from an external file
Bmp1 := TPicture.Create;
Bmp1.LoadFromFile('c:\where\b1.BMP');
Bmp1Handle := Bmp1.Bitmap.Handle;
CheckedHandle := Bmp1Handle;

// or - using resources in the EXEcutable
Bmp1Handle := LoadBitmap(hInstance, 'RESOURCENAME');
CheckedHandle := LoadBitmap(hInstance, 'CHECKED_IMAGE');

// assign the bitmaps
SetMenuItemBitmaps(MenuItemTest.Handle, 0, MF_BYPOSITION,
  Bmp1Handle, CheckedHandle);
...

Templates Delphi

Problem/Question/Abstract:

Templates in Delphi

Answer:

Here is an overview about the different templates in Delphi and where they are stored.
Important: If you reinstall or update Delphi, you should save these files first!

delphi32.dci
Delphi source file templates in a text file

delphi32.dct
Delphi Component Template IDE binary file with the Delphi componens templates

delphi32.dmt
Delphi Menu Template IDE / Menu designer binary file with the menu templates

delphi32.dro
Delphi Repository Options ID text file with the object repository's settings

How to add items of a TListBox as sub-items to a selected tree node

Problem/Question/Abstract:

I have TreeView1, Button1 and ListBox1. ListBox one has x number of items. I need to be able to click Button1 and the items in ListBox1 are inserted as sub-items to the selected tree-node.

Answer:

var
  ix: integer;
  parentnode: TTreeNode;

  TreeView.Items.BeginUpdate;
try
  parentnode := TreeView.FocusedNode;
  for ix := 0 to ListBox1.Items.Count - 1 do
  begin
    if parentnode = nil then
      Tree.Items.Add(nil, ListBox1[ix])
    else
      Tree.Items.AddChild(parentnode, ListBox1[ix]);
  end;
finally
  TreeView.Items.EndUpdate;
end;

Move components from Delphi 5 to Delphi 6

Problem/Question/Abstract:

Have you tried to compile your components, or 3rd party components you have in Delphi 5 into Delphi 6?
99% of them will not compile. However do not despare. It is only because of a few changes Borland has implemented on their latest product. This article covers the major changes.

Answer:

First of all, you will discover that the unit dsgnintf.pas is missing. Borland changed the name to Designintf.pas, moved the property editor code to a new unit, called DesignEditors.pas, put the constants used inside DesignConsts.pas and the menus inside DesignMenus.pas

Also the variants have moved from system.pas to their own unit called Variants.pas

The IFormDesigner interface isn't there anymore. You should use the IDesigner and typecast your variables. (this is a change probably made to accomodate the CLX and I was unable to find any documentation on it from either Borland or Delphi 6 Online help system. I only found that every IFormDesigner has been repaced with IDesigner)

The IDesignerSelections interface has also changed. The most helpfull change is the addition of a Get function that returns a TPersistent when giving the index of the member.

On previous versions if you wanted the TPersistent of an object you wrote:

var
  p: TPersistant;
  ...
    P := Selections[i] as TPersistant;

Now you only write:

var
  p: TPersistant;
  ...
    P := Selections.get[i];

That's about it. I have used these simple instructions to recompile all of  my third party tools, and all of my custom components.

P.S. Just remember... you have to have the source code to do this!!! :-)

Determine if a given TTable has a restricted view

Problem/Question/Abstract:

I am trying to write a function to determine if a given TTable has a restricted view. The filtered and master-detail views are easy. Is there a way to determine if SetRange / ApplyRange, etc. have been used for a table? This is for Paradox tables.

Answer:

TMyTable = class(TTable)
public
  function IsRangeActive: Boolean;
end;

function TMyTable.IsRangeActive: Boolean;
begin
  Result := BuffersEqual(GetKeyBuffer(kiRangeStart), GetKeyBuffer(kiCurRangeStart),
    SizeOf(TKeyBuffer) + RecordSize) and BuffersEqual(GetKeyBuffer(kiRangeEnd),
    GetKeyBuffer(kiCurRangeEnd), SizeOf(TKeyBuffer) + RecordSize);
end;