Compacting an Access database with ADO and Delphi

Compacting an Access database with ADO and Delphi
While working in a database application you change data in a database, the database becomes fragmented and uses more disk space than is necessary. Periodically, you can compact your database to defragment the database file. This article shows how to use JRO from Delphi in order to compact an Access database from code.
Why compacting While you add and delete records from database tables, your database becomes more and more fragmented and uses disk space inefficiently. Compacting a database makes a copy of the database, rearranging how the database file is stored on disk. The compacted database is usually smaller and often runs faster. This chapter of the free database course for Delphi beginners shows how to use JRO from Delphi in order to compact an Access database from code. JRO TLB ADO does not directly expose a method for compacting a database. By using Jet and Replication Objects (JRO), you can compact databases, refresh data from the cache, and create and maintain replicated databases. The JRO exposes two objects, the JetEngine object and the Replica object. The Replica object is used to manipulate replicated databases. We will not deal with database replications in this chapter. By using the Jet Engine object we can programmatically control compacting and refreshing data from the memory cache. As with ADOX, the JRO library must be imported in Delphi, since it is not a part of the ADOExpress (or dbGo in D6). The description of the ADOX library is "Microsoft Jet and Replication Objects 2.x Library (Version 2.x)". The JRO library file name is MSJRO.dll. We've already seen the steps needed to import a type library in Delphi (ADOX). The same process should be repeated in this case. To import JRO in Delphi you need to open a new project and Select Project | Import Type Library. In the dialog box choose "Microsoft Jet and Replication Objects 2.x Library (Version 2.x)". Note that it will add two new classes, the TReplica and TJetEngine. Press Install button to add JRO to a package or press Create unit to just create a single interface unit. If you click Install, two new icons will appear on the ActiveX tab (if you have left the default Palette page on the Dialog). Note: Delphi 6 users will not succeed in importing JRO type library. If you have Delphi 6, while trying to install the library in a package, an error will pop up indicating that ActiveConnection in the JRO_TLB file doesn't exist (along with some other errors). The problem lies in Delphi 6 TLB importer. There are two options to overcome the problem: 1. Use Delphi 5 to import JRO an then install it in Delphi 6. 2. Manually declare the missing ActiveConnection property and change property declarations to make them writeable. Compact Delphi Project It's time to see some code. Create a new Delphi application with one form. Add two Edit controls and a Button. From the ActiveX component page pick JetEngine. The first Edit should be renamed to edSource, the second one to edDest. The button should be renamed to btnComapct. The JetEngine should be renamed to JE. It should all look like: The TJetEngine class has a CompactDatabase method. The method takes two parameters: the ADO connection string for the source as well for the destination database. CompactDatabase method compacts a database and gives you the option of changing its version, password, collating order and encryption. Encrypting a database makes it indecipherable by a utility program or word processor. Encrypted databases can still be opened by Access or through Delphi code. The proper way to protect a database is to set a password for it. Collation order is used for string comparison in the database. Changing a database version gives you the way to "upgrade" it. In our form, the edSource is used to specify the database we want to compact. The edDest specifies the destination database. Within the connection strings, you specify various connection properties to determine how the source database is opened and how the destination database is compacted. At a minimum, you must use the Data Source property in each connection string to specify the path and name of the database. When you use the CompactDatabase method, you can't save the compacted database to the same name as the original database. CompactDatabase also requires that the destination database does not exist. The next code (btnCompact OnClick event handler) is an example of the CompactDatabase method: procedure TForm1.btnCompactClick(Sender: TObject); var dbSrc : WideString; dbDest : WideString; const SProvider = 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source='; begin dbSrc := SProvider + edSource.Text; dbDest := SProvider + edDest.Text; if FileExists(edDest.Text) then DeleteFile(edDest.Text); JE.CompactDatabase(dbSrc,dbDest); end; Note that the above code presumes an Access 2000 database. Microsoft Jet OLEDB 4.0 is the default data engine for Access 2000. In many cases you'll want to have the same database name after the compact operation. Since edSource and edDest can't be the same your code should replace the original file with the compacted version. The next function takes only one parameter - the name of the database you want to compact: function DatabaseCompact (const sdbName: WideString) : boolean; var JE : TJetEngine; //Jet Engine sdbTemp : WideString; //TEMP database sdbTempConn : WideString; //Connection string const SProvider = 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source='; begin Result:=False; sdbTemp := ExtractFileDir(sdbName) + 'TEMP' + ExtractFileName(sdbName); sdbTempConn := SProvider + sdbtemp; if FileExists(sdbTemp) then DeleteFile(sdbTemp); JE:= TJetEngine.Create(Application); try try JE.CompactDatabase(SProvider + sdbName, sdbTempConn); DeleteFile(sdbName); RenameFile(sdbTemp, sdbName); except on E:Exception do ShowMessage(E.Message); end; finally JE.FreeOnRelease; Result:=True; end; end; The DatabaseCompact receives a sdbName string parameter with the full name of the database you want to compact. The function returns True if compact is successful False otherwise. The sdbName is compacted in sdbTemp, the sdbName is then deleted and sdbTemp renamed to sdbName. The DatabaseCompact could be called as: DatabaseCompact('C:\ADP\aboutdelphi.mdb'); The DatabaseCompact function is ideal to be called from within your Delphi ADO application as an external application. It could also be written as a console mode application that takes one command line parameter (or more) since it requires no GUI.

Add a Check Box to a standard dialog box

Suppose you have a confirmation dialog of some kind, where the user can select a checkbox displayinfg "Don't show this message again"). When the user closes the dialog - program can store the state of the check box (checked or not checked) in a global variable - the next time you need to display this dialog - you simply don't show it. The idea of realization is:
1. Create a dialog using CreateMessageDialog
2.This function will return a form object with dialog
3. In this object we can add a checkbox
4. Show dialog using ShowModal
5. Check a result and process a state of the checkbox
6. Destroy the created checkbox and the dialog


procedure TForm1.Button1Click(Sender: TObject) ;
var AMsgDialog: TForm;
ACheckBox: TCheckBox;
begin
___AMsgDialog := CreateMessageDialog('This is a test message.', mtWarning, [mbYes, mbNo]) ;
___ACheckBox := TCheckBox.Create(AMsgDialog) ;
___with AMsgDialog do
___try
______Caption := 'Dialog Title' ;
______Height := 169;
______with ACheckBox do
______begin
_________Parent := AMsgDialog;
_________Caption := 'Don''t show me again.';
_________Top := 121;
_________Left := 8;
______end;
______if (ShowModal = ID_YES) then
______begin
______if ACheckBox.Checked then
_________//do if checked
______else
_________//do if NOT checked
______end;
___finally
______Free;
___end;
end;

Get Default Printer Name

Here's how to get the name of the default printer on a computer:

~~~~~~~~~~~~~~~~~~~~~~~~~
uses Printers;
function GetDefaultPrinterName : string;
begin
___if (Printer.PrinterIndex > 0)then
___begin
______Result := Printer.Printers[Printer.PrinterIndex];
___end else
___begin
______Result := '';
___end;
end;

Incremental Search for the TListBox Delphi Control

The TListBox Delphi control displays a collection of items in a scrollable list. Items can be selected by clicking on an item, the ItemIndex property gets or sets the index of the selected item. Incremental Searching for a ListBoxImagine a list box with a huge number of (unsorted) items. Finding the one user wants to select might turn into a nightmare. Let's provide the user with an option to immediately locate the item in the list box by adding incremental search functionality. Drop a TEdit and a TListBox on a form. Leave the default names: "Edit1" and "ListBox1".

Handle the Edit1's OnChange event as:

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

procedure TListBoxSearchForm.Edit1Change(Sender: TObject) ;

const indexStart = -1;

var search : array[0..128] of Char;

begin

___//make sureLength(Edit1.Text) <= 128

___StrPCopy(search, Edit1.Text) ;

___ListBox1.ItemIndex := ListBox1.Perform(LB_SELECTSTRING, indexStart, LongInt(@search)) ;

end;

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The StrPCopy

RTL function copies Edit1.Test string value into a null-terminated string variable "search".
The Perform method sends the specific LB_SELECTSTRING message directly to ListBox1.

Add Row Number In DBGrid

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1. create new blank field in dbgrid
2. rename the title with 'No'
3. put this code in OnDrawColumncell
4. Now your Grid has a row number
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if DataSource1.DataSet.RecNo > 0 then
begin
if Column.Title.Caption = 'No' then
DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top, IntToStr(DataSource1.DataSet.RecNo));
end;
end;

Drag'n'Drop nodes inside TreeView

The following code uses GetNodeAt to add a dragged node as a child of the node under then mouse when it is dropped.

~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer) ;
var
___AnItem: TTreeNode;
___AttachMode: TNodeAttachMode;
___HT: THitTests;
begin
___if TreeView1.Selected = nilthen Exit;
___HT := TreeView1.GetHitTestInfoAt(X, Y) ;
___AnItem := TreeView1.GetNodeAt(X, Y) ;
___if (HT - [htOnItem, htOnIcon, htNowhere, htOnIndent]<> HT) then
___begin
______if (htOnItem in HT) or (htOnIcon in HT) then
_________AttachMode := naAddChild
______else if htNowhere in HT then
_________AttachMode := naAdd
______else if htOnIndent in HT then
_________AttachMode := naInsert;
______TreeView1.Selected.
______MoveTo(AnItem, AttachMode) ;
___end;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Mengetahui Jumlah Mapping Drive dalam Jaringan Komputer

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function GetNetworkDriveMappings (SList: TStrings): integer;
var
____c: Char;
____ThePath: string;
____MaxNetPathLen: DWord;
begin
____SList.Clear;
____MaxNetPathLen := MAX_PATH;
____SetLength(ThePath, MAX_PATH) ;
____for c := 'A' to 'Z' do
____if WNetGetConnection(PChar('' + c + ':'), PChar(ThePath),MaxNetPathLen) = NO_ERROR then ____________sList.Add(c + ': ' + ThePath) ;
____Result := SList.Count;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Change glyphs of TDBNavigator Buttons

Form1 has a DBNavigator1. In the OnCreate event for the form the custom bitmap ('GoFirst') for the First button is loaded from the resource.

~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.FormCreate(Sender: TObject) ;
var
___i : Integer;
___tempGlyph : tBitmap;
begin
___tempGlyph :=TBitmap.Create;
___try
______tempGlyph.LoadFromResourceName(HInstance,'GoFirst') ;
______with DBNavigator1 do
______begin
_________for i := 0 to ControlCount - 1 do
____________if Controls[c] is TNavigateBtn then
____________with TNavigateBtn(Controls[c])
____________do begin
_______________case Index of
_______________nbFirst: Glyph := tempGlyph;
____________end;
_________end;
______end;
___finally
______tempGlyph.Free;
___end;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Implementing OnMouseOver for Items in a TComboBox, with custom hints.

Here's how to get the caption of an item in a TComboBox as mouse hovers over an item when the ComboBox is in drop down state. Use this "trick" to get the object associated with the "pre-selected" item in a combo box, or to display a custom hint for each item, for example.
When a TComboBox is in drop down state, and you move around the items with mouse, the item the mouse is over is "pre-selected" (colored in "clHighLight" color). If you ever wanted to get the text of that "pre-selected" item (to show a hint for this item, for example), you probably noticed that such a property does not exist. When a combo box is dropped down, its Items are displayed in a list box type of control. The VCL TListBox component does actually provide an OnMouseOver event, yet, this event will not fire for TComboBox's list box since the list box part of the combobox is not a VCL control. If you were lucky and the TComboBox's list box was TListBox, than you will have no problems to "get ListBox items as mouse hovers over them". However, if you need to know what TComboBox item is "pre-selected", you'll need a little trick... TComboBox.Items OnMouseMove In order to get the text of the combo box item "under" the mouse, when the combo is in drop down state, you need to send some specific messages to the actual list box displayed. Your best bet is to place the code in the Application.OnIdle event handler since this event is fired when it is waiting for input from the user (not processing application's code). The code provided below is an example of how to get the name of the combo box and the text of the item the mouse hovers over. Firstly, we get the handle of the window under the mouse (WindowFromPoint), we check if the window is a combo box (GetClassName). Secondly, we get the index of the "pre-selected" item (by sending the LB_ITEMFROMPOINT message to the underlying list box). Next, if we have a valid item index, we get the text of the item by sending the LB_GETTEXT message. Finally, the combo box name and the item text are displayed in a TLabel component. procedure TForm1.ApplicationIdle( sender: TObject; var Done: boolean); var pt : TPoint; w : Hwnd; ItemBuffer : array[0..256] of Char; idx : Integer; s : string; begin pt := Mouse.CursorPos; w := WindowFromPoint(pt); if w = 0 then Exit; GetClassName(w, ItemBuffer, SizeOf(ItemBuffer)); if StrIComp(ItemBuffer, 'ComboLBox') = 0 then begin Windows.ScreenToClient(w, pt); idx := SendMessage(w, LB_ITEMFROMPOINT, 0, LParam(PointToSmallPoint(pt))); if idx >= 0 then begin if LB_ERR <> SendMessage(w, LB_GETTEXT, idx, LParam(@ItemBuffer)) then begin s:= 'Mouse over item: ' + #13#10 + Format('Combo.Name: %s,%sItem.Text: %s', [ActiveControl.Name,#13#10,ItemBuffer]); ComboItemLabel.Caption := s; //explained later hw.DoActivateHint(ActiveControl.Name + ItemBuffer, 'Hint for: ' + ItemBuffer); end; end; end; end; (*ApplicationIdle*) That's it. Tricky yet simple. In the sample application provided for download, there's also code that "activates" the ApplicationIdle procedure when the combo box fires its OnDropDown event; similary the Application.OnIdle is set to nil when the combo box fires the OnCloseUp event. TComboBox.Item custom hint messages As you can see from the screen shot, you can attach custom hint text for each combo box item. In general, a class TComboItemHint that derives from THintWindow is used to display custom hint messages for each item. The DoActivateHint procedure calls the ActivateHint method of the THintWindow. ActivateHint displays the hint window at the specified coordinates (where the mouse is). type TComboItemHint = class(THintWindow) private DoHint : boolean; FControlName: string; procedure SetControlName(const Value: string); private property ControlName : string read FControlName write SetControlName; public procedure DoActivateHint( ControlName : string; Text : string); end; ... procedure TComboItemHint.DoActivateHint( ControlName : string; Text: string); var pt : TPoint; r : TRect; begin self.ControlName := ControlName; if DoHint then begin pt := Mouse.CursorPos; //some hard-coding r:= Rect(pt.X + 16, pt.Y + 16, pt.X + 100, pt.Y + 32); ActivateHint(r,Text); DoHint := false; end; end; procedure TComboItemHint.SetControlName( const Value: string); begin if FControlName <> Value then begin ReleaseHandle; //remove flicker DoHint := True; FControlName := Value; end; end;

Show any graphics format as Glyph on a SpeedButton

TBitBtn dan TSpeedButton hanya bisa menerima picture berformat BMp , jika kita hanya memiliki format ICO atau JPG dan ingin menampilkan sebagai Glyph, kita butuh konversi ke Bitmap, berikut Langkahnya :

~~~~~~~~~~~~~~~~~~~~~~~~~
var
___bmp: TBitmap;
begin
___bmp:=TBitmap.Create;
___try
______bmp.Width := Image.Picture.Graphic.Width;
______bmp.Height := Image.Picture.Graphic.Height;
______bmp.Canvas.Draw(0, 0, Image.Picture.Graphic) ;
______BitBtn.Glyph:=bmp;
___finally
______bmp.Free;
___end;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

How to set system wide Hot Key for a Delphi application

Bila sebuah aplikasi berada pada posisi minimze di tray icon dan kita ingin restore aplikasi dengan short cut "Alt-Shift-F9" agar berada pada posisi aktif form. berikut contohnya :

~~~~~~~~~~~~~~~~~~~~~~~~~
//In the main forms OnCreate
//handler assign the hotkey:

If not RegisterHotkey
(Handle, 1, MOD_ALT or MOD_SHIFT, VK_F9) Then
ShowMessage('Unable to assign Alt-Shift-F9 as hotkey.') ;

//In the main forms
//OnClose event remove the handler:

UnRegisterHotkey( Handle, 1 ) ;

//Add a handler for the
//WM_HOTKEY message to the form:

private // form declaration
Procedure WMHotkey( Var msg: TWMHotkey ) ;
message WM_HOTKEY;

Procedure TForm1.WMHotkey( Var msg: TWMHotkey ) ;
Begin
__If msg.hotkey = 1 Then
__Begin
____ If IsIconic( Application.Handle ) Then
______Application.Restore;
____BringToFront;
__End;
End;
~~~~~~~~~~~~~~~~~~~~~~~~~

Minimize Child Forms Independent of the Main Form

Bagaimana jika child form dari MDI form tetap tampil saat MDI Form di minimize ?

By design, Delphi applications only have one button on the Windows Task Bar for the whole application. When you, for example, minimize the main form of an SDI application, Delphi minimizes the main form and than hides all other windows in the application as well.

SDI? MDI?

SDI means Single Document Inteface. By default, the FormStyle property of all Delphi forms added to the application is set to fsNormal, so that the IDE assumes that all new applications are SDI applications.

Being an SDI application, does not mean you can not have more than one form in the application. In most cases, of course, you will have more than one form - but only one form is the main form of the application.

The main form is the first form created in the main body of the application. When the main form closes, the application terminates. As stated, in an SDI application, when the user minimizes the main form, all other forms get hidden too. Also, only the main form (to be precise, the application) will have a button on the task bar. When a child form is minimized it gets minimized to the Windows Desktop.

Note: contrary to the SDI, in an MDI application, more than one document or child window can be opened within a single parent window. FormStyle property for a MDI parent is fsMDIForm.

Power to the Child Forms!

Let's say you do not want child forms to hide when the main form minimizes. What you need to do is to change the ExStyle of the Params property in the overriden CreateParams method. What's more, you also need to change the parent window of a child form - set it to Windows Desktop.

This is how the CreateParams should look:

interface

type
___TChildForm = class(TForm)
...
protected
___procedure CreateParams(var Params: TCreateParams) ; override;
...

implementation

procedure TChildForm.CreateParams(var Params: TCreateParams) ;
begin
___inherited;

___Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;

___Params.WndParent := GetDesktopWindow;
end;

By setting the child form's parent window handle to the Desktop, you remove the link that would normally force the whole application to come to the top when this form comes to the top.
By design, all secondary forms point to the main form of the application for parentage. Clicking on a secondary form's taskbar button while another application is active will bring all the applications forms to front. By using GetDesktopWindow API you change this behaviour.

That's it. Simply override the CreateParams of every child form type in your project and have them minimize independently of the main form.

Note: you could have a base child form class with overriden CreateParams, then have all your child forms inherit the base class.

Implementing OnActivate / OnDeactivate for MDI Child Forms

Find out what MDI Child WAS Active

In an MDI application, more than one document or child window can be opened within a single parent window. If you need to react when a certain MDI child form becomes active you can handle the OnActivate event of the child form. The OnActivate event is fired when the form (MDI child in this case) receives the input focus. If you need to react when a certain MDI child is being deactivated you can handle the OnDeactivate event. OnDeactivate is fired when the form transitions from being the active form to another form in the same application becoming the active form.

What if you need to extract some data from the MDI child form being deactivated from the form being activated?

You need to handle a special MDI Windows message: WM_MDIACTIVATE.

Note: every (MDI parent) Delphi form exposes the ActiveMDIChild property.

ActiveMDIChild basically returns the active MDI child form.

What we are after here is implementing something like OnActiveMDIChildChange event!

What MDI Child is Being Deactivated?

The WM_MDIACTIVATE message can be handled on the MDI parent level and on the MDI child level. MDI parent level means writing code to handle the message in the MDI parent form. MDI child level means handling the message on the child level - inside every MDI child form.

On the MDI parent level the message can be used to identify the MDI child window being activated.

More interestingly, on the MDI child level the WM_MDIACTIVATE message caries the HWND (handle) of the MDI child form being deactivated. This means that from the active MDI child form handling the WM_MDIACTIVATE message you can get your hands on the previously active MDI child window!

Note: in any MDI application you should have one base form for all your MDI child forms - then use form inheritance (VFI) to extend the functionality for each particular MDI child type form.

You will then write the code to handle the WM_MDIACTIVATE message only once - inside the base MDI child form class.

message WM_MDIACTIVATE

To handle WINDOWS message write a message method for this message:

type
//MDI child form
___TMDIChild = class(TForm)
private
___procedure WMMDIACTIVATE(var msg : TWMMDIACTIVATE) ; message
...
end;

WM_MDIACTIVATE;

In the implementation get the MDI child that was previously activate ("now" deactivated) and get some data from it:

procedure TMDIChild.WMMDIACTIVATE(var msg: TWMMDIACTIVATE) ;
var
___deactivated : TWinControl;
___deactivatedChild : TMDIChild;
begin
//find the control (form) being deactivated
___deactivated := FindControl(msg.DeactiveWnd) ;

//if deactivated is a TMDIChild form .. do something ...
___if Assigned(deactivated) AND (deactivated is TMDIChild) then
___begin
______deactivatedChild := TMDIChild(deactivated) ;

______Caption := 'deactivated: ' + deactivatedChild.Caption;
___end;
end;

The msg procedure parameter holds the info related to the WM_MDIACTIVATE message.

Note that WM_MDIACTIVATE is first sent to the child window being deactivated and then to the child window being activated.

The above code uses FindControl to get the TWinControl descendant whose window handle is identified by the DeactiveWnd HWND value. Since DeactiveWnd identifies the MDI child window being deactivated, FindWindow will locate the MDI child that was previously active.

When you make sure the previously active MDI child was found, you might need to check its type and do some special processing ... I'll leave this up to you...

Highlighting Delphi's DBGrid Row On Mouse over

Memberikan efek Highlight pada DbGrid pada event on mouse over

Hot Tracking for TDBGrid

Delphi's TDBGrid displays and manipulates records from a dataset in a tabular grid.

Contrary to what most novice developers think, the DBGrid component allows various customizations. changing the color of a specific cell or a column or even a row is not complicated at all.
What most are not aware of, is that you can even implement the OnMouseHover (hot tracking)change the display (color, font, etc.) of the DBGRid's (data) row underneath the mouse - *not* the currently selected row - thus making it look like today's web driven interfaces. behavior to
I'm sure you've seen this behavior many times - many tables on the Web change the background color of their rows as mouse hovers over them.

Coloring DBGrid's Row On Mouse Hover

To follow the source code provided later on, create a new application. On the form ("Form1") drop a DBGrid ("DBGrid1"). Use any type of TDataset descentand and connect to some database data to make sure the dbgrid has some data to show.

Note: All he code goes inside the Form1's unit source!!

For a start, prepare the protected hack for the DBGrid component. In the interface section, just add the following line:

type
___THackDBGrid = class(TDBGrid) ;

Next, add a private integer property "MouseOverRow" - you'll use it to track the index position of the row the mouse is over.

private fMouseOverRow: integer;
procedure SetMouseOverRow(const Value: integer) ;
property MouseOverRow : integer read fMouseOverRow write SetMouseOverRow;

To be able to track the row the mouse is over you need to handle the OnMouseMove DBGrid1's event.

//DBGrid1 OnMouseMove
procedure TForm1.DBGrid1MouseMove(Sender: TObject;Shift: TShiftState;X, Y: Integer) ;
var
___ gc: TGridCoord;
begin
___gc := DBGrid1.MouseCoord(x, y) ;
___MouseOverRow := gc.Y;
end

The MouseOverRow property's setter calls the Refresh method that will in turn fire the DrawColumnCell event.

procedure TForm1.SetMouseOverRow(const Value: integer) ;
begin
___if fMouseOverRow <> Value then
___begin
______fMouseOverRow := Value;
______DBGrid1.Repaint;
___end;
end;

As expected the tricky part goes inside the OnDrawColumnCell event handling procedure.

//DBGrdi1 OnDrawColumnCell
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;const Rect: TRect;DataCol: Integer;Column: TColumn;State: TGridDrawState) ;
begin
___if NOT ((gdFocused in State) or (gdSelected in State)) AND (MouseOverRow = 1 + THackDBGrid(DBGrid1).DataLink.ActiveRecord) then
___begin
______with DBGrid1.Canvas do
______begin
_________Brush.Color := clSilver;
_________Font.Color := clNavy;
______end;
___end;

___DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State) ;
end;

What we want is to change the drawing color of the row the mouse is over.

Therefore:

If MouseOverRow matches the ActiveRecord value of the protected DataLink property and the cell being drawn does not have the focus and is not selected: change the Canvas's coloring to actually "draw" the row highlighted.

The tricky part here was the protected DataLink property and the ActiveRecord value. The DataLink property helps the data-aware grid manage its link to the data source and respond to data events. The ActiveRecord specifies the index of the current record within the internal record buffer maintained by the dataset for the Owner of the TDataLink object.

You might think that ActiveRecord points to the currently selected record for the data displayed in the grid, but it is not.

Note: you might ask yourself: "how does he know this". Here's the answer: I read Delphi Help files and browse the VCL source code

While Delphi draws data the DBGrid displays it changes the ActiveRecord to match the row being drawn.

And this is the trick: match the currently drawn row woth the one the mouse is over. That's it. Beauty!

Tbutton Dengan multiline Caption

The next procedure sets Captions on all TButton Controls on a given Parent to be multi-lined...


procedure SetMultiLineButton(AParent: TWinControl) ;
var
___j : integer;
___ah : THandle;
begin
___for j := 0 to AParent.ControlCount - 1 do
___begin
______if (AParent.Controls[j] is TButton) then
______begin
_________ah := (AParent.Controls[j] as TButton).Handle;
_________SetWindowLong(ah, GWL_STYLE,GetWindowLong(ah, GWL_STYLE) OR BS_MULTILINE) ;
______end;
___end;
end;


{
usage: suppose there is a
Button1 and Button2 on Form1,
Button3 and Button4 on Panel1 on Form1
by calling the next line
}

SetMultiLineButton(Panel1);

{only Button3 and Button4 will have
multi-lined caption.
}
~~~~~~~~~~~~~~~~~~~~~~~~~

Set File Date (created)

Here's a procedure to change the created date "attribute" for a given file:

function SetFileDate(Const FileName : String;Const FileDate : TDateTime): Boolean;
var
___FileHandle : THandle;
___FileSetDateResult : Integer;
begin
___try
______try
_________FileHandle := FileOpen(FileName,fmOpenWrite OR fmShareDenyNone) ;
_________if FileHandle > 0 Then
_________begin
____________FileSetDateResult :=
____________ FileSetDate(FileHandle,DateTimeToFileDate(FileDate)) ;
____________result := (FileSetDateResult = 0) ;
_________end;
_________except
_________Result := False;
______end;
___finally
______FileClose (FileHandle) ;
___end;
end;

{Usage:}
SetFileDate('c:\mydir\myfile.ext', Now)

Store User and Application Data in the Correct Location

SHGetFolderPath retrieves the full path of a known folder identified.

Here's a custom wrapper function around the SHGetFolderPath API to help you get any of the standard folders for all or the currently logged Windows user.

uses SHFolder;

function GetSpecialFolderPath(folder : integer) : string;
const
___SHGFP_TYPE_CURRENT = 0;
var
___ path: array [0..MAX_PATH] of char;
begin
___if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then
______ Result := path
___else
______Result := '';
___end;

Here's an example of using the SHGetFolderPath function:

• Drop a TRadioButtonGroup (name: "RadioGroup1") on a form
• Drop a TLabel (name: "Label1") on a form
• Add 5 items to the radio group:
  1. "[Currenty User]\My Documents"
  2. "All Users\Application Data"
  3. "[User Specific]\Application Data"
  4. "Program Files"
  5. "All Users\Documents"
• Handle the RadioGroup's OnClick event as:

Note: "[Current User]" is the name of the currently logged in Windows user.

//RadioGroup1 OnClick
procedure TForm1.RadioGroup1Click(Sender: TObject) ;
var
___index : integer;
___specialFolder : integer;
begin
___if RadioGroup1.ItemIndex = -1 then Exit;

___index := RadioGroup1.ItemIndex;

___case index of
______//[Current User]\My Documents
______0: specialFolder := CSIDL_PERSONAL;
______//All Users\Application Data
______1: specialFolder := CSIDL_COMMON_APPDATA;
______//[User Specific]\Application Data
______2: specialFolder := CSIDL_LOCAL_APPDATA;
______//Program Files
______3: specialFolder := CSIDL_PROGRAM_FILES;
______//All Users\Documents
______4: specialFolder := CSIDL_COMMON_DOCUMENTS;
___end;

___Label1.Caption := GetSpecialFolderPath(specialFolder) ;
end;

Note: The SHGetFolderPath is a superset of SHGetSpecialFolderPath.

You should not store application-specific data (such as temporary files, user preferences, application configuration files, and so on) in the My Documents folder. Instead, use an application-specific file that is located in a valid Application Data folder.

Always append a subfolder to the path that SHGetFolderPath returns. Use the following convention: "\Application Data\Company Name\Product Name\Product Version".