Delphi Knowledge Base

2006. november 14., kedd

How to set a TEdit or TMemo to overwrite instead of insert

Problem/Question/Abstract:

How to set a TEdit or TMemo to overwrite instead of insert

Answer:

Solve 1:

You have to fake it because the control does not natively support overtype mode. Provide overtype capability for edits and memos:

procedure TScratchMain.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Sender is TCustomEdit) and Odd(GetKeyState(VK_INSERT)) then
    with TCustomEdit(Sender) do
      if SelLength = 0 then
        case Key of
          ' '..#126, #128..#255:
            begin
              SelLength := 1;
              if (SelLength > 0) and (SelText[1] = #13) then
                SelLength := 2;
            end;
        end;
end;

With this handler the control will start out in insert mode since the state of VK_INSERT is not toggled by default. Pressing it once will toggle the key and put the control in overtype mode. If you want it to start out in overtype, use "not Odd(...)" in the If statement.

Solve 2:

I managed to simulate it by doing this (you need to declare the FOverwrite: boolean somewhere in the form):

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
type
  TSmallPoint = packed record
    case integer of
      0: (x, y: Smallint);
      1: (long: integer);
  end;
var
  CaretPos: TPoint;
  sCaretPos: TSmallPoint;
begin
  if (FOverwrite) and (Edit1.SelLength = 0) then
  begin
    GetCaretPos(CaretPos);
    sCaretPos.x := CaretPos.x;
    sCaretPos.y := CaretPos.y;
    Edit1.SelStart := SendMessage(Edit1.Handle, EM_CHARFROMPOS, 0, sCaretPos.long);
    Edit1.SelLength := 1;
    Edit1.SelText := Key;
    Key := #0;
  end;
end;

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_INSERT: FOverwrite := not FOverwrite;
  end;
end;

2006. november 13., hétfő

How to start a search upon an [Enter] key press in a TEdit

Problem/Question/Abstract:

I have a series of 6 edit boxes that users type info in that are then passed to params in my SQL TQuery. The search query is started by clicking on a button. However, users have asked that if they type in one of the edit boxes and then press 'Enter' that the system searches. I can use Key Press event to trigger it and then if key = #13 to make sure its the enter key but then i want it to trigger the procedure that does the search, usually triggered by the tool button. Any ideas?

Answer:

Solve 1:

The best solution is to use actions, which I'll describe below. But if you don't want to use actions, do this:

Move your search procedure into a separate procedure, and then call that from both the toolbutton OnClick and edit OnKeyPress events, like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    {Private Declarations}
    procedure PerformSearch;
  public
    {Public declarations}
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  PerformSearch;
end;

procedure TForm1.PerformSearch;
begin
  { Do search here }
  ShowMessage('Search performed');
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    PerformSearch;
    Key := #0;
  end;
end;

end.

To use actions, place a TActionList component onto your form, then create an action called something like "SearchAction". Then assign SearchAction to the ToolButton's Action property. Finally, call the action's Execute method from the edit, like this:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ActionList1: TActionList;
    SearchAction: TAction;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure SearchActionExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    SearchAction.Execute;
    Key := #0;
  end;
end;

procedure TForm1.SearchActionExecute(Sender: TObject);
begin
  { Do search here }
  ShowMessage('Search performed');
end;

end.

Solve 2:

I'll go one further than Rick. All event handlers should only delegate (unless they're one line long in which case they are delegating). In other words if you have

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  {...many lines of code that actually implement the search}
end;

Change this to:

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  FindInformation;
end;

procedure TForm1.FindInformation;
begin
  {...many lines of code that actually implement the search.}
end;

There are, of course, exceptions to this rule, however, for the greater part, you will not do wrong to treat an event handler as a proxy rather than placing the code directly in it. For one thing, it makes it easier to move the domain code into a separate object, so you could end up with:

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  MyInformationFinder.Execute;
end;

2006. november 12., vasárnap

Cancel that wrong drag operation

Problem/Question/Abstract:

Cancel that wrong drag operation

Answer:

Have you ever started moving a component while designing your form and realized you selected the wrong component?

No doubt, you can think of other instances when you would like to cancel a design-time drag operation you've already begun. Here's a tip that let's you do just that.

After you've begun the drag but before you release the mouse button, press the Esc key. The control will snap back to its original position!

2006. november 11., szombat

Manipulate shapes and inline shapes in Word

Problem/Question/Abstract:

I'm trying to insert a picture in a document and sent it to the back, with the text over the picture using automation.

Answer:

If Doc is a Word document:

{ ... }
var
  Pic: Word2000.Shape;
  Left, Top: OleVariant;
  { ... }

{To add a pic and make it appear behind text}
Left := 100;
Top := 100;
Pic := Doc.Shapes.AddPicture('C:\Small.bmp', EmptyParam, EmptyParam, Left, Top,
  EmptyParam, EmptyParam, EmptyParam);
Pic.WrapFormat.Type_ := wdWrapNone;
Pic.ZOrder(msoSendBehindText);
{To get a watermark effect}
Pic.PictureFormat.Brightness := 0.75;
Pic.PictureFormat.Contrast := 0.20;
{To make any white in a picture transparent}
Pic.PictureFormat.TransparencyColor := clWhite;
Pic.PictureFormat.TransparentBackground := msoTrue;
Pic.Fill.Visible := msoFalse;
{ ... }

2006. november 10., péntek

How to simulate combobox behaviour with a TEdit

Problem/Question/Abstract:

I'm trying to make a component that acts in certain cases like a combobox, i.e. when the user presses a button, a list box is shown and the user can select an item. The problem I have is that I need the list to hide itself whenever the user clicks the mouse outside the list (including clicks in non-windowed controls).

Answer:

One way you can do this is by listening for CM_CANCELMODE messages in the parent of your drop-down list (presumably an edit control or something similar). You will probably then have to work out whether the message originated from a click on the drop-down list or elsewhere. In the code below, FPopup points to the list component:

procedure TMyPopupEdit.CMCancelMode(var Message: TCMCancelMode);
var
  P: TPoint;
  R: TRect;
begin
  {Get the top-left coordinate of the Sender and see if it is within the popup
  control. If not, close the popup without changing the text in the edit box.}
  P.X := Message.Sender.Left;
  P.Y := Message.Sender.Top;
  R := Rect(0, 0, FPopup.Width, FPopup.Height);
  if not PtInRect(R, P) then
    if FPopupVisible then
      PopupCloseUp(FPopup, False);
end;

2006. november 9., csütörtök

How to implement the RPos

Problem/Question/Abstract:

Sometime Pos is not enough, because you need to find the position of the first character of a sub string in a string from the end of that string. There's the solution.

Answer:

function RPos(Substr: string; S: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  if ((Length(S) > 0) and (Length(Substr) > 0)) then
    if (Length(S) >= Length(Substr)) then
      for i:= (Length(S) - Length(Substr)) downto 1 do
        if (Copy(S, i, Length(Substr)) = Substr) then
        begin
          Result := i;
          Exit;
        end;
end;

2006. november 8., szerda

How to set all tables linked to a TDatabase back to active

Problem/Question/Abstract:

Is there a way to set all tables linked to a particular TDatabase component back to active automatically?

Answer:

Not totally automatic but with just two lines of code. If you want certain tables that share DB1 to keep closed (shadow tables etc, only opened for special routines) use the Tag of the DataSets to determine which ones to open.

for i := 0 to pred(DB1.DataSetCount) do
{if DataSets.Tag = 1 then}
DataSets[i].Open;

2006. november 7., kedd

2006. november 6., hétfő

How to use Randomize so that the same value is not chosen more than once (2)

Problem/Question/Abstract:

Would you mind to make me a random procedure to change the background of my program in an interval of 15 seconds?

Answer:

The best would be to store the names in an array:

const
  CaImgs: array[0..9] of string = ('image1.jpg', 'image2.jpg', ...);

This way, on start-up, you can check that the images are there. Then, if you merely want a random image from the array, you do:

myFileName = CaImgs[random(10)];

This means that you have one chance out of ten of repeating the same image - no visible change. If you want to show always different images, but in random order, then you need a shuffle function (see above). To shuffle your array of filenames (despite being declared a constant, it's actually a var), you do this:

procedure shuffleImages;
var
  a: array[0..high(CaImgs)] of integer;
  j: integer;
  s: string;
begin
  for j := low(a) to high(a) do
    a[j] := j;
  shuffle(a, 0);
  for j := low(a) to high(a) do
  begin
    s := CaImgs[j];
    CaImgs[j] := CaImgs[a[j]];
    CaImgs[a[j]] := s;
  end;
end;

You do this once at application start. This way, the 10 images will show in random order (but the order will repeat throughout the current run).

In both cases (random of shuffle), you should call Randomize just once, at the start of the application.

2006. november 5., vasárnap

How to tell if a TPanel is moved outside the visible part of a TForm

Problem/Question/Abstract:

I use SC_DRAGMOVE so I can drag a TPanel around a form. Now, how do I tell the form when the panel is outside the form and the form should add some scrollbars?

Answer:

unit Unit1;

interface

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

type
  TPanel = class(ExtCtrls.TPanel)
  private
    procedure WMExitSizeMove(var message: TMessage); message WM_EXITSIZEMOVE;
  end;

  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  Mouse.Capture := 0;
  sendmessage(panel1.handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

{ TPanel }

procedure TPanel.WMExitSizeMove(var message: TMessage);
begin
  Left := Left + 1;
  Left := Left - 1;
end;

end.

2006. november 4., szombat

One way to copy whole contents of an array into another array

Problem/Question/Abstract:

You have an array and you want to copy the value you have in it to another array.

Answer:

I just use a button to se if it compile and if I get an Error when I click it. There ar other ways, like copy an array in a for loop, but then you have to know how big it is. If you handle different arrays in an application and need to copy them into one, this is the way. As you can se, it works with just one index of the array too.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    Array1: array[0..40] of Integer;
    Array2: array[0..100] of Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Move(Array1, Array2, SizeOf(Array1)); {Moves/Copy the Array1 to Array2.}
end;

end.

2006. november 3., péntek

Trapping Messages Sent to an Application

Problem/Question/Abstract:

I wrote code for the OnMessage event handler of Application object to trap all Windows messages sent to my application, but it doesn't seem to fire on all messages. Is there a way to trap all messages sent to my application?

Answer:

There sure is. And the answer to this "problem" is amazingly simple. But before I go into trapping messages at the application level, I should probably discuss some mechanics.

TApplication's "Hidden" Window
It's not a commonly known fact that the default Application object creates a hidden window when your application is started. But you can seen evidence of this by creating a new application saving it, then running it (make sure you don't rename anything - just keep the main form as "Form1" and the project as "Project1). When you run the application, you'll notice that the caption bar for your main form says, "Form1" while the icon displayed on the task bar says "Project1." That icon represents the application's hidden window, and it affects your program in many ways, especially when you're trying to handle messages sent to your application.
Delphi surfaces the OnMessage event for the Application object. The OnMessage event handler is "supposed" to allow you trap every message sent to your application. But there's a problem with this: OnMessage will only fire when there's something in the Application object's message queue. These messages are typically window management messages such as WM_PAINT or messages sent to the application from Windows through PostMessage, Broadcast or SystemMessage . However, messages sent directly to a window using SendMessage bypass the Application object's message queue, so OnMessage doesn't fire for those types of situations.
Some of you more familiar with handling windows messages might think that a solution to the problem above might be to override the WndProc method for the Application object. Unfortunately, that's not possible because TApplication's WndProc method is not only private, it's also declared as a static method which means it's not overrideable. So it's not only invisible, you can't create a TApplication subclass to override WndProc (not that you'd want either). But that doesn't mean that you can't get to the WndProc method using alternative means.

"Hooking" All Messages
Even though WndProc is all but closed to direct subclassing, TApplication does include a method called HookMainWindow that allows you to insert your own message handler at the top of WndProc to intercept messages sent to your application before they're handled by the Application object. This is convenient for all developers, and solves the problem of trapping any message sent to your application.
HookMainWindow is declared under TApplication as follows:

procedure HookMainWindow(Hook: TWindowHook);

Notice that HookMainWindow takes one parameter, Hook of type TWindowHook. TWindowHook is a method pointer type that's defined like so:

type
  TWindowHook = function(var Message: TMessage): Boolean of object;

Since TWindowHook is a method pointer, you can define your own method as the hook function as long as it follows the nomenclature defined for TWindowHook. Notice that the return value of the function is of type Boolean. This is the equivalent of the "Handled" parameter of OnMessage. If your function handles a particular message, you'd return true. This will be passed back to the Application's WndProc and message processing for that message will be terminated. Otherwise, you'd return False. Here's an example method:

function TForm1.AppHookFunc(var Message: TMessage): Boolean;
begin
  Result := False; //I just do this by default
  if Message.Msg = WM_ < SomethingOrOther > then
  begin
    ...DoSomething...
      Result := True;
  end;
end;

Okay, now that we've set up everything, we need to make the application hook the messages. This can be done in the main form's OnCreate method:

function TForm1.FormCreate(Sender: TObject);
begin
  HookMainWindow(AppHookFunc);
end;

I should mention that you need to clear the hook using, you guessed it, UnHookMainWindow, after you're done using it, and this can be done in the OnDestroy for the main form:

function TForm1.FormDestroy(Sender: TObject);
begin
  UnHookMainWindow(AppHookFunc);
end;

Okay, disgustingly simple. But I feel the best things in life are those that give maximum satisfaction for the least amount of cost (please don't read ANYTHING into that <G>). So, now you've got the tools to create your own message "hooker" (sorry, had to do that at least once). Until next time...

2006. november 2., csütörtök

How to convert decimal numbers to fractions

Problem/Question/Abstract:

I'm looking for a function that I can pass in a decimal and return a fraction.

Answer:

Solve 1:

The "Denominators" parameter is an array of potential denominators that would be acceptable. For example, to get a fractional inch dimension with a power of 2 denominator, you'd pass [2, 4, 8, 16, 32] for that parameter, and the function will figure out which potential denominator will work best.

function ConvertFloatToFraction(const Value: Double;
  const Denominators: array of Integer): string;
var
  Index: Integer;
  TempDelta: Double;
  MinDelta: Double;
  TempNumerator: Integer;
  FracValue: Double;
  Numerator: Integer;
  Denominator: Integer;
  IntValue: Integer;
begin
  IntValue := Trunc(Value);
  FracValue := Abs(Frac(Value));
  MinDelta := 0;
  Numerator := 0;
  Denominator := 0;
  for Index := 0 to High(Denominators) do
  begin
    TempNumerator := Round(FracValue * Denominators[Index]);
    TempDelta := Abs(FracValue - (TempNumerator / Denominators[Index]));
    if ((Index = 0) or (TempDelta < MinDelta)) then
    begin
      MinDelta := TempDelta;
      Numerator := TempNumerator;
      Denominator := Denominators[Index];
    end;
  end;
  if (Numerator = Denominator) then
  begin
    IntValue := IntValue + Sign(IntValue);
    Numerator := 0;
  end;
  Result := '';
  if ((IntValue <> 0) or (Numerator = 0)) then
    Result := IntToStr(IntValue);
  if ((IntValue <> 0) and (Numerator <> 0)) then
    Result := Result + ' ';
  if (Numerator <> 0) then
    Result := Result + IntToStr(Numerator) + '/' + IntToStr(Denominator);
end;

Solve 2:

This function takes the number to convert, the fraction scale you want returned such as 8 for eighths or 10 for tenths, etc. and a boolean to tell it to round up or down the nearest fraction. It returns a string with the integer portion, a space and then the fraction portion. It will also reduce the fraction to the smallest common denominator. You can use the ErrorFactor variable to adjust the percentage of when to consider a number close enough to the next level to be close enough. I use 4 percent of the fractional scale value.

function ToFraction(num: double; scale: integer; RoundUp: boolean): string;

{Function to find greatest common denominator}
  function GCD(A, B: integer): integer;
  begin
    if (B mod A) = 0 then
      result := A
    else if (B mod A) = 1 then
      result := 1
    else
      result := GCD((B mod A), A);
  end;

var
  x, y: integer;
  ScaleFrac,
    NumFrac,
    ErrorFactor: double;
begin
  ScaleFrac := 1 / scale;
  NumFrac := Frac(Num);
  ErrorFactor := ScaleFrac * 0.04; {error factor of 4 percent}
  x := 0;
  while (((x + 1) * ScaleFrac) < (NumFrac + ErrorFactor)) do
    inc(x);
  if RoundUp then
    if (((((x + 1) * ScaleFrac) - NumFrac) / 2) > (ScaleFrac / 2)) then
      inc(x);
  if (x = 0) then {no fraction, just the integer portion}
  begin
    result := IntToStr(Trunc(Num))
  end
  else
  begin {reduce the fraction as much as possible}
    y := GCD(x, scale);
    while (y <> 1) do
    begin
      x := x div y;
      scale := scale div y;
      y := GCD(x, scale);
    end;
    result := IntToStr(Trunc(Num)) + ' ' + IntToStr(x) + '/' + IntToStr(scale);
  end;
end;

2006. november 1., szerda

Create 32bit string resources with 16bit Resource Workshop

Problem/Question/Abstract:

Create 32bit string resources with 16bit Resource Workshop

Answer:

There is an easy way to do this (besides buying Resource Workshop version 4 :-)

create your strings as 16bit resource with Resource Workshop
store them as a *.RC text file (instead of *.RES)
compile the text file with BRCW32 (command line tool: BRC32) into a 32bit *.RES file