Categories
Delphi

QUICK Duplicate Current Record Procedure

For the purposes of this example please assume there is no primary key or constraints on the table. In reallity you would probably want to duplicate a record then change one of the field values, before it is appended.

The problem is that to use dataset.append, dataset.setthefieldvalues, dataset.post, as soon as the append is called, you loose the current record which pointed to the record you want to duplicate. So you could use two datasets and copy one to the other, but this uses extra memory, etc. or you could copy the contents of the current record into a temporary place then call the append.

Taking this second option :
The first solution I came up with was to use VarArrayCreate, but this was slow. Another altenative was to go lower level and use the ActiveBuffer method, but then your getting into memory copies etc. and I didn`t know enough about the internal memory representation of a record.

So this is what I came up with, and has the added benefit of being faster than using the dataset.append dataset.setthefieldvalues dataset.post method. It simply copies the current record in to an array of variant (note NOT a variant array which needs redimsand the such) then uses the dataset.appendrecord method to add the record in one go.

procedure DuplicateCurrentRecord(aDataSet : TDataSet); 
var
  Data : array of variant; 
  aRecord : array of TVarRec; 
  i : integer; 
  max : integer; 
begin
  max := aDataSet.fields.count -1; 
// set the lenghth of the arecord array to be the same as the number of 
// elements in the data array 
  SetLength(arecord,max+1); 
  SetLength(data,max+1); 
// set the variant type pointers to the data array 
for i := 0 to max do
begin
    arecord[i].VType := vtVariant; 
    arecord[i].VVariant := @data[i]; 
end
// Copy the Record to the Array 
for i := 0 to max do
    Data[i] := aDataSet.fields[i].value; 
// finally append the record in one go
  aDataSet.AppendRecord(aRecord); 
end;

Categories
Delphi

How to Ensure TEdits are defocused and changes saved on form closure

Some controls that create edit boxes or combos to allow editing of the information they display, for example the TVirtualStringTree, component do not loose the focus when a form is closed, and as such the changes to the edit are not applied. This can be fixed easily with a one-liner.

To ensure that popup edits, independant of the type of control have finished editing, i.e. have lost their focus when a form is closed, simply put the following line in the closequery event.

if assigned(ActiveControl) and (ActiveControl).Focused then DefocusControl(ActiveControl,false);

This line will ensure that the current control that has focus is defocused. It basically checks to see if a control is focused and if it is, Defocuses it.  This should work with all controls, e.g. dropdowns, edits and ensures that edit changes are committed.

Categories
Delphi

Painting the background of TEdit

TEdit is a fairly low level component utilizing the standard windows edit window. How on earth do we get the background to be something other than a color.. Can we make it transparent or put a picture in. I don’t know if the following works in versions previous to Delphi 6 but I can’t see why it would not.

This unit is a transparent TEdit descendant.

If you want to put your own background in instead of it being transparent change the else clause of the if Transparent in WMEraseBkGnd.

unit Z9Edit;
interface
uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;
type
  TZ9Edit = class(TEdit)
private
{ Private declarations }
    FAlignText: TAlignment;
    FTransparent: Boolean;
    FPainting: Boolean;
procedure SetAlignText(Value: TAlignment);
procedure SetTransparent(Value: Boolean);
protected
{ Protected declarations }
procedure RepaintWindow;
procedure CreateParams(var Params: TCreateParams); override;
procedure Change; override;
procedure SetParent(AParent: TWinControl); override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
procedure PaintParent(ACanvas: TCanvas);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Align;
property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
property Transparent: Boolean read FTransparent write SetTransparent default false;
end;
implementation
{ TZ9Edit }
uses
  Forms;
type
  TParentControl = class(TWinControl);
const
  BorderRec: array[TBorderStyle] of Integer = (1, -1);
constructor TZ9Edit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
  FAlignText := taLeftJustify;
  FTransparent := false;
  FPainting := false;
end;
destructor TZ9Edit.Destroy;
begin
inherited Destroy;
end;
procedure TZ9Edit.SetAlignText(Value: TAlignment);
begin
if FAlignText <> Value then
begin
    FAlignText := Value;
    RecreateWnd;
     Invalidate;
end;
end;
procedure TZ9Edit.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
    FTransparent := Value;
    Invalidate;
end;
end;
procedure TZ9Edit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
  DC: hDC;
  i: integer;
  p: TPoint;
  canvas : TCanvas;
begin
if FTransparent and not(csDesigning in componentstate) then
begin
    canvas := TCanvas.create;
try
      canvas.handle := message.dc;
      PaintParent(Canvas);
finally
      canvas.free;
end;
end
else
begin
    canvas := TCanvas.create;
try
      canvas.handle := message.dc;
      canvas.brush.color := Color;
      canvas.brush.style := bsSolid;
      canvas.fillrect(clientrect);
finally
      canvas.free;
end;
end;
end;
procedure TZ9Edit.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then RepaintWindow;
end;
procedure TZ9Edit.WMNCPaint(var Message: TMessage);
begin
inherited;
end;
procedure TZ9Edit.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then SetBkMode(Message.ChildDC, 1);
end;
procedure TZ9Edit.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then SetBkMode(Message.ChildDC, 1);
end;
procedure TZ9Edit.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then Invalidate;
end;
procedure TZ9Edit.WMSize(var Message: TWMSize);
var
  r : TRect;
begin
inherited;
  r := ClientRect;
  InvalidateRect(handle,@r,false);
end;
procedure TZ9Edit.WMMove(var Message: TWMMove);
var
  r : TRect;
begin
inherited;
  Invalidate;
  r := ClientRect;
  InvalidateRect(handle,@r,false);
end;
procedure TZ9Edit.RepaintWindow;
var
  DC: hDC;
  TmpBitmap, Bitmap: hBitmap;
begin
if FTransparent then
begin
    FPa
inting := true;
    HideCaret(Handle);
    DC := CreateCompatibleDC(GetDC(Handle));
    TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
    Bitmap := SelectObject(DC, TmpBitmap);
    PaintTo(DC, 0, 0);
    BitBlt(GetDC(Handle), BorderRec[BorderStyle] + BorderWidth, BorderRec[BorderStyle] + BorderWidth, ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);
    SelectObject(DC, Bitmap);
    DeleteDC(DC);
    ReleaseDC(Handle, GetDC(Handle));
    DeleteObject(TmpBitmap);
    ShowCaret(Handle);
    FPainting := false;
end;
end;
procedure TZ9Edit.CreateParams(var Params: TCreateParams);
const
  Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];
end;
procedure TZ9Edit.Change;
begin
  RepaintWindow;
inherited Change;
end;
procedure TZ9Edit.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;
procedure TZ9Edit.PaintParent(ACanvas: TCanvas);
var
  I, Count, X, Y, SaveIndex: integer;
  DC: cardinal;
  R, SelfR, CtlR: TRect;
  Control : TControl;
begin
  Control := Self;
if Control.Parent = nil then Exit;
  Count := Control.Parent.ControlCount;
  DC := ACanvas.Handle;
  SelfR := Bounds(Control.Left, Control.Top, Control.Width, Control.Height);
  X := -Control.Left; Y := -Control.Top;
// Copy parent control image
  SaveIndex := SaveDC(DC);
  SetViewportOrgEx(DC, X, Y, nil);
  IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
  TParentControl(Control.Parent).Perform(WM_ERASEBKGND,DC,0);
  TParentControl(Control.Parent).PaintWindow(DC);
  RestoreDC(DC, SaveIndex);
//Copy images of graphic controls
for I := 0 to Count – 1 do begin
if (Control.Parent.Controls[I] <> nil) then
begin
if Control.Parent.Controls[I] = Control then break;
with Control.Parent.Controls[I] do
begin
        CtlR := Bounds(Left, Top, Width, Height);
if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then
begin
          SaveIndex := SaveDC(DC);
          SetViewportOrgEx(DC, Left + X, Top + Y, nil);
          IntersectClipRect(DC, 0, 0, Width, Height);
          Perform(WM_ERASEBKGND,DC,0);
          Perform(WM_PAINT, integer(DC), 0);
          RestoreDC(DC, SaveIndex);
end;
end;
end;
end;
end;
end.

Categories
Delphi

GDI+ TextureBrush paints image offset

The GDI plus TextureBrush renders The brush from the origin of the Graphics canvas that it is drawing to, so if you fill a rectange with a textured brush starting at 10,10 then the brush appears offset.
To ensure the top left corner of the image you have used in your texture brush starts at the same place onthe rectangle you are filling we need to set the brushes translation Transformation to the top left corner of the rectange to fill.
e.g
  ABrush  := TGPTextureBrush.Create(AImage,WrapModeTile);
  ABrush.TranslateTransform(x,y);
  AGraphics.FillRectangle(ABrush,x,y,width,height);
  ABrush.free;

Categories
Delphi

How to reduce the flicker of Page Controls with XP Manifest

In the create of the Form, set the form and the page controls DoubleBuffered to True.
  DoubleBuffered := True;
  Pages.DoubleBuffered := True;

Categories
Delphi

Show / Hide a Forms icon and caption in the Taskbar

It is possible to hide the applications mainform from the taskbar or put other forms in your application on the task bar by simply changing the create params as the form is constructed.
Override the Form’s CreateParams and add one of the following to either remove or add to the taskbar
to Show in the taskbar

procedure TForm.CreateParams(var Params: TCreateParams);
begin
  ExStyle := ExStyle or WS_EX_APPWINDOW;
end;

to remove from the taskbar

procedure TForm.CreateParams(var Params: TCreateParams);
begin
  ExStyle := ExStyle and not  WS_EX_APPWINDOW;
end;

Categories
Delphi

Delphi Register procedure will not Register Controls

So, you’re changing your packages and splitting them up nicely into a runtime and design time package.  You create a new Component Registration unit and add a register procedure, compile it all up and the register procedure never gets called and the components are not registered……

Oh, how many times has this happened to me ? 

I finally worked out what was wrong.  Not being a copy and paste guy, I typed in the register procedure and didn’t capitalise the ‘R’.  Therefore the entry point to the DLL is never found !  Oh those case-sensitive C programmers have a lot to answer for.
Please ensure the procedure Register is the correct case 🙂

Categories
General

Return to Sender

Following the success of the online story composition of “Snakes on a Plane”, I am proud to announce the next collaborative movie “Return to Sender”.

Overview

Our friendly American Postal worker, a happy and go lucky chappie adored by all his customers is happily delivering him mail one morning.  He looks into his bag to find a brown paper package, which under closer observation, is ticking. He hadn’t noticed that before.  The package is split slightly, exposing a couple of wires and a numerical display counting down. It currently reads 9 hours 11 minutes.

Suspecting he is carrying a terrorist bomb, Postie (name to be decided) examines (gently) the package further to find that the postal regulation required return address is printed on a neat metallic sticker (with flowers embossed in the corner).

At that moment, Postie decides… He will Return to Sender….

 

Scene Padding

Carrying a potentially live bomb is probably not the most sensible thing to do, especially considering the day Postie is having. During his efforts to return to sender, Postie has a car accident, crashing his postal van into the back of a school bus, carrying disabled kids on a day trip to the zoo.  Fearing for their lives, he jumps from the speeding postal van, cascading down the embankment on to the freeway…

Will he survive the onslaught of traffic ? Will he survive the jump ? Will he manage to Return to Sender before the counter reaches zero and give them a taste of their own medicine ?

 

You decide…..

 

Please add any plot suggestions to the comments.

Categories
General

Buxton Raceway

Took the kids to Buxton Raceway on Bank Holiday Monday.  It’s a fantastic afternoon out. Adults £11 kids under 8 free, which worked out great for me.  As well as Formula 2 Stock Car racing, Super Bangers and Hot rods, they had a 10 car jump.  I was really chuffed with the pictures I took, so posted below….

 


Click the above image for a larger view.

Buxton Raceway is just off the Leek road near Buxton, UK:

Categories
Delphi

How to provide Dragging or Resizing of any control.

The WM_SYSCOMMAND Message gives us various options for manipulating windows and replicating user input, but there are some undocumented parameters that are very useful.

The MSDN Documentation provides various usefull valid parameters that can be passed in the WParam of the message.

These are as follows:

  • SC_CLOSE – Closes the window.
  • SC_CONTEXTHELP – Changes the cursor to a question mark with a pointer. If the user then clicks a control in the dialog box, the control receives a WM_HELP message.
  • SC_DEFAULT – Selects the default item; the user double-clicked the window menu.
  • SC_HOTKEY – Activates the window associated with the application-specified hot key. The lParam parameter identifies the window to activate.
  • SC_HSCROLL – Scrolls horizontally.
  • SC_KEYMENU – Retrieves the window menu as a result of a keystroke. For more information, see the Remarks section.
  • SC_MAXIMIZE – Maximizes the window.
  • SC_MINIMIZE – Minimizes the window.
  • SC_MONITORPOWER – Sets the state of the display. This command supports devices that have power-saving features, such as a battery-powered personal computer.
    The lParam parameter can have the following values:
    1 – the display is going to low power
    2 – the display is being shut off
  • SC_MOUSEMENU – Retrieves the window menu as a result of a mouse click.
  • SC_MOVE – Moves the window.
  • SC_NEXTWINDOW – Moves to the next window.
  • SC_PREVWINDOW – Moves to the previous window.
  • SC_RESTORE – Restores the window to its normal position and size.
  • SC_SCREENSAVE – Executes the screen saver application specified in the [boot] section of the System.ini file.
  • SC_SIZE – Sizes the window.
  • SC_TASKLIST – Activates the Start menu.
  • SC_VSCROLL – Scrolls vertically.

In addition there are some undocumented constants that can be used as well.

  • SC_DragMove = $F012;
    Will start a Drag operation to move the window. This is similar tot he effect you get when you drag the caption of a winodw, however using this in the mouse down on a form, instantly gives you a form that can be dragged by clicking anywhere.
  • SC_DRAGSIZE_N = $F003;
    Starts a resize operation on the top edge of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_S = $F006;
    Starts a resize operation on the bottom edge of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_E = $F002;
    Starts a resize operation on the right edge of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_W = $F001;
    Starts a resize operation on the left edge of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_NW = $F004;
    Starts a resize operation on the Top left corner of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_NE = $F005;
    Starts a resize operation on the top right corner of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_SW = $F007;
    Starts a resize operation on the bottom left corner of the form. The window then supports either keyboard or mouse resizing.
  • SC_DRAGSIZE_SE = $F008;
    Starts a resize operation on the bottom right corner of the form. The window then supports either keyboard or mouse resizing.

To use these constants we simply send a perform message to the window we wish to work with.
e.g.

AFormMouseDown(…)
begin
ReleaseCapture;
// releases the capture of mouse events for this form
Perform(WM_SYSCOMMAND,SC_DragMove,0);
// send the drag move message
end
;

It is important to use the release capture method to tell windows not to send the mouse messages to the form that has just received the mouse down.