Listbox With Multiple Columns

Delphi's TListBox control displays a collection of items in a
scrollable list. By design, a listbox displays its items in one column.

If you want to display several items in one row, thus have multiple
columns in a list box you need to set the TabWidth property and add
items to theListBox in a specific way.

begin

___ListBox1.Items.Add('First'^I'Second'^I'Third') ;
___ListBox1.Items.Add('C1R1'^I'C2R1'^I'C3R1') ;
___ListBox1.Items.Add('C1R2'^I'C2R2'^I'C3R2') ;
___ListBox1.Items.Add('C1R3'^I'C2R3'^I'C3R3') ;
___ListBox1.Items.Add('C1R4'^I'C2R4'^I'C3R4') ;
___ListBox1.Items.Add('C1R5'^I'C2R5'^I'C3R5') ;
___ListBox1.Items.Add('C1R6'^I'C2R6'^I'C3R6') ;
___ListBox1.Items.Add('C1R7'^I'C2R7'^I'C3R7') ;
___ListBox1.Items.Add('C1R8'^I'C2R8'^I'C3R8') ;


___ListBox1.Items.Add('C1R9'^I'C2R9'^I'C3R9') ;

end;

Make an Application window full screen

Set the Borderstyle of your main form to bsNone and then use
SystemParametersInfo message to get the SPI_GETWORKAREA value then use
SetBounds to make your Window the correct size.




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

procedure TSomeForm.FormShow(Sender: TObject) ;

var

r : TRect;

begin

Borderstyle := bsNone;

SystemParametersInfo

(SPI_GETWORKAREA, 0, @r,0) ;

SetBounds

(r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top) ;

end;

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

How to Minimize ALL the windows on the Desktop

~~~~~~~~~~~~~~~~~~~~~~~~~
uses ShlObj;

procedure Shell_MinimizeAll;
var
___Shell : OleVariant;
begin
___Shell := CreateOleObject('Shell.Application') ;
___Shell.MinimizeAll;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Disable Screensaver

{Insert the following code into the
"public" section of
your main form:}


procedure AppMessage(var Msg : TMsg;var bHandled : boolean ) ;
{In the OnCreate for the main form add:}
Application.OnMessage := AppMessage;
{In the "implementation" section, insert the
following code (suppose Form1 is the name of your form):}

procedure TForm1.AppMessage(var Msg : TMsg;
___var bHandled : boolean ) ;
begin
___if((WM_SYSCOMMAND = Msg.Message) and
______(SC_SCREENSAVE = Msg.wParam) )then
______bHandled := True;
end;

Flip Bitmap (Horizontal or Vertical)

Here's a sample code that flips the bitmap vertical or horizontal
and creates a new bitmap:

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

{

Usage:
BitmapFlip(True,
False,
Image1.Picture.Bitmap,
Image1.Picture.Bitmap
) ;

}


interface
Uses Windows,Graphics;


Function BitmapFlip(
___Const Vertical : Boolean;
___Const Horizontal : Boolean;
var BitmapIn : TBitmap;
___ out BitmapOut : TBitmap): Boolean;


implementation


Type
___TColorData = Array[0..128000] Of TRGBTriple;
___pColorData = ^TColorData;

Function BitmapFlip( Const Vertical : Boolean;
_____________________Const Horizontal : Boolean;
var BitmapIn : TBitmap;
___out BitmapOut : TBitmap): Boolean;

Var DataIn : pColorData;
___DataOut : pColorData;
___inRow : Integer;
___inCol : Integer;

Begin
___Result := False;
___Try
___If BitmapIn.PixelFormat <> pf24bit Then Exit;
___With BitmapOut Do
___Begin
______Width := BitmapIn.Width;
______Height := BitmapIn.Height;
______PixelFormat := BitmapIn.PixelFormat;
___End;

___For inRow := 0 To BitmapIn.Height - 1 Do
___Begin
______DataIn := BitmapIn.Scanline[inRow];
______If Vertical Then
______Begin
_________DataOut := BitmapOut.ScanLine
_________[BitmapIn.Height - 1 - inRow];
______End
___Else
___Begin
______DataOut := BitmapOut.ScanLine[inRow];
___End;

___If Horizontal Then
___Begin
______For inCol := 0 To BitmapIn.Width-1 Do
_________DataOut[inCol] := DataIn[BitmapIn.Width-1-inCol];
___End
___Else
___Begin
______For inCol := 0 To BitmapIn.Width-1 Do
______DataOut[inCol] := DataIn[inCol];
___End;
___End;
______Result := True;
___Except
___End;
End;
End.


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

Get Default Printer Name

Iseng-iseng siapa tau ada manfaatnya


uses Printers;

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

Setting IP Address, Subnet dan Gateway computer di Delphi

Artikel dibawah ini menerangkan bagaimana setting IP Address, Subnet dan Gateway computer. Caya yang digunakan adalah dengan menggunakan class WMI API OLE

Contoh

jika SetIpConfig('192.168.1.5') = 0 maka Set ke STATIC IP
jika SetIpConfig('') = 0. Maka Set ke DHCP
jika SetupConfig('dhcp') = 0 Maka Set ke DHCP
jika SetIpConfig('196.11.175.221','196.11.175.1') = 0 itu berarti menuliskan IP STATIC + GATEWAY

Unit reference yang digunakan adalah : ComObj, ActiveX, UrlMon

Function yang akan dubuat adalah :
function SetIpConfig(const AIpAddress : string; const AGateWay : string = ''; const ASubnetMask : string = '') : integer;
function SetDnsServers(const APrimaryDNS : string; const AAlternateDNS : string = '') : integer;

Dengan Return Value sbb :
0 Successful completion, no reboot required.
1 Successful completion, reboot required.
-1 Unknown OLE Error
64 Method not supported on this platform.
65 Unknown failure.
66 Invalid subnet mask.
67 An error occurred while processing an instance that was returned.
68 Invalid input parameter.
69 More than five gateways specified.
70 Invalid IP address.
71 Invalid gateway IP address.
72 An error occurred while accessing the registry for the info.
73 Invalid domain name.
74 Invalid host name.
75 No primary or secondary WINS server defined.
76 Invalid file.
77 Invalid system path.
78 File copy failed.
79 Invalid security parameter.
80 Unable to configure TCP/IP service.
81 Unable to configure DHCP service.
82 Unable to renew DHCP lease.
83 Unable to release DHCP lease.
84 IP not enabled on adapter.
85 IPX not enabled on adapter.
86 Frame/network number bounds error.
87 Invalid frame type.
88 Invalid network number.
89 Duplicate network number.
90 Parameter out of bounds.
91 Access denied.
92 Out of memory.
93 Already exists.
94 Path, file, or object not found.
95 Unable to notify service.
96 Unable to notify DNS service.
97 Interface not configurable.
98 Not all DHCP leases could be released or renewed.
100 DHCP not enabled on adapter.

---------------------------------------------------------}

uses ComObj, ActiveX, UrlMon;


function SetIpConfig(const AIpAddress : string; const AGateWay : string = '';
const ASubnetMask : string = '') : integer;
var Retvar : integer;
___oBindObj : IDispatch;
___oNetAdapters,oNetAdapter,
___oIpAddress,oGateWay,
___oWMIService,oSubnetMask : OleVariant;
___i,iValue : longword;
___oEnum : IEnumvariant;
___oCtx : IBindCtx;
___oMk : IMoniker;
___sFileObj : widestring;
begin
___Retvar := 0;
___sFileObj := 'winmgmts:\\.\root\cimv2';

___// Create OLE [IN} Parameters
___oIpAddress := VarArrayCreate([1,1],varOleStr);
___oIpAddress[1] := AIpAddress;
___oGateWay := VarArrayCreate([1,1],varOleStr);
___oGateWay[1] := AGateWay;
___oSubnetMask := VarArrayCreate([1,1],varOleStr);
___if ASubnetMask = '' then
______oSubnetMask[1] := '255.255.255.0'
___else
______oSubnetMask[1] := ASubnetMask;

___// Connect to WMI - Emulate API GetObject()
___OleCheck(CreateBindCtx(0,oCtx));
___OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
___OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
___oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +
__________________ 'Win32_NetworkAdapterConfiguration ' +
__________________ 'where IPEnabled=TRUE');
___oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

___while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
___try
______// Set by DHCP ? (Gateway and Subnet ignored)
______if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then
_________Retvar := oNetAdapter.EnableDHCP
______// Set via STATIC ?
______else begin
_________Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
_________// Change Gateway ?
_________if (Retvar = 0) and (AGateWay <> '') then
____________Retvar := oNetAdapter.SetGateways(oGateway);

______end;
___except
_________Retvar := -1;
___end;

______oNetAdapter := Unassigned;
___end;

___oGateWay := Unassigned;
___oSubnetMask := Unassigned;
___oIpAddress := Unassigned;
___oNetAdapters := Unassigned;
___oWMIService := Unassigned;
___Result := Retvar;
end;



function SetDnsServers(const APrimaryDNS : string;
__________________ const AAlternateDNS : string = '') : integer;
var Retvar : integer;
___oBindObj : IDispatch;
___oNetAdapters,oNetAdapter,
___oDnsAddr,oWMIService : OleVariant;
___i,iValue,iSize : longword;
___oEnum : IEnumvariant;
___oCtx : IBindCtx;
___oMk : IMoniker;
___sFileObj : widestring;
begin
___Retvar := 0;
___sFileObj := 'winmgmts:\\.\root\cimv2';
___iSize := 0;
___if APrimaryDNS <> '' then inc(iSize);
___if AAlternateDNS <> '' then inc(iSize);

___// Create OLE [IN} Parameters
___if iSize > 0 then begin
______oDnsAddr := VarArrayCreate([1,iSize],varOleStr);
______oDnsAddr[1] := APrimaryDNS;
______if iSize > 1 then oDnsAddr[2] := AAlternateDNS;
___end;

___// Connect to WMI - Emulate API GetObject()
___OleCheck(CreateBindCtx(0,oCtx));
___OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
___OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
___oWMIService := oBindObj;

___oNetAdapters := oWMIService.ExecQuery('Select * from ' +
_________ 'Win32_NetworkAdapterConfiguration ' +
_________ 'where IPEnabled=TRUE');
___oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
___while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
___try
______if iSize > 0 then
_________Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)
______else
_________Retvar := oNetAdapter.SetDNSServerSearchOrder();
___except
______Retvar := -1;
___end;

______oNetAdapter := Unassigned;
___end;

___oDnsAddr := Unassigned;
___oNetAdapters := Unassigned;
___oWMIService := Unassigned;
___Result := Retvar;
end;



fungsi lain yang ada pada Win32_NetworkAdapterConfiguration Class

DisableIPSec
EnableDHCP
EnableDNS
EnableIPFilterSec
EnableIPSec
EnableStatic
EnableWINS
ReleaseDHCPLease
ReleaseDHCPLeaseAll
RenewDHCPLease
RenewDHCPLeaseAll
SetArpAlwaysSourceRoute
SetArpUseEtherSNAP
SetDatabasePath
SetDeadGWDetect
SetDefaultTTL
SetDNSDomain
SetDNSServerSearchOrder
SetDNSSuffixSearchOrder
SetDynamicDNSRegistration
SetForwardBufferMemory Specifies
SetGateways
SetIGMPLevel
SetIPConnectionMetric
SetIPUseZeroBroadcast
SetIPXFrameTypeNetworkPairs
SetIPXVirtualNetworkNumber
SetKeepAliveInterval
SetKeepAliveTime
SetNumForwardPackets
SetPMTUBHDetect
SetPMTUDiscovery
SetTcpipNetbios
SetTcpMaxConnectRetransmissions
SetTcpMaxDataRetransmissions
SetTcpNumConnections
SetTcpUseRFC1122UrgentPointer
SetTcpWindowSize
SetWINSServer

Mengetahui & Mengubah Computer Name

Terkadang kita ingin mengubah computer name melalui aplikasi yang kita buat. berikut ini adalah cara untuk membaca nama komputer dan merubah nama komputer

{Membaca nama komputer }

function GetComputerName: string;
var
___buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
___Size: Cardinal;
begin
___Size := MAX_COMPUTERNAME_LENGTH + 1;
___Windows.GetComputerName(@buffer, Size);
___Result := StrPas(buffer);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
___ShowMessage(GetComputerName);
end;


{ Merubah nama komputer - untuk merubah pastikan login dg hak administrator}

function SetComputerName(AComputerName: string): Boolean;
var
___ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
___Size: Cardinal;
begin
___StrPCopy(ComputerName, AComputerName);
___Result := Windows.SetComputerName(ComputerName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
___if SetComputerName('NewComputerName') then
______ShowMessage('Computer Name Reset Setting will be used at next startup.')
___else
______ ShowMessage('Computer Name Not Reset');
end;


Selamat Mencoba.. Semoga berhasil

Creating and Using DLLs from Delphi

Introduction to DLLs. How to create (and use) a DLL in Delphi A Dynamic Link library, or DLL, is a collection of routines (small programs) that can be called by applications and by other DLLs. Like units, DLLs contain sharable code or resources, they provide the ability for multiple applications to share a single copy of a routine they have in common. The concept of DLLs is the core of the Windows architectural design, and for the most part Windows is simply a collection of DLLs. Naturally, using Delphi, we can write and use our own DLLs, and we can call functions in DLLs developed with other systems / by other developers (like Visual Basic, or C/C++). Creating a Dynamic Link Library The following few lines will demonstrate how to create a simple DLL using Delphi. For the beginning start Delphi and select File | New ... DLL. This will create a new DLL template in the editor window. Select the default text and replace it with the next piece of code. library TestLibrary; uses SysUtils, Classes, Dialogs; procedure DllMessage; export; ___begin ShowMessage('Hello world from a Delphi DLL') ; end; exports DllMessage; begin end. If you look at the project file of any Delphi application, you’ll see that it starts with the reserved word Program. By contrast, DLLs always begin with the reserved word Library. This is then followed by a uses clause for any needed units. In this simple example, there then follows a procedure called DllMessage which does nothing except showing a simple message. At the end of the source code we find an exports statement. This lists the routines that are actually exported from the DLL in a way that they can be called by another application. What this means is that we can have, let's say, 5 procedures in a DLL and only 2 of them (listed in the exports section) can be called from an external program (the remaining 3 are "sub procedures" in a DLL). In order to use this simple DLL, we have to compile it by pressing Ctrl+F9. This should create a DLL called SimpleMessageDLL.DLL in your projects folder. Finally, let's see how to call the DllMessage procedure from a (statically loaded) DLL. To import a procedure contained in a DLL, we use the keyword external in the procedure declaration. For example, given the DllMessage procedure shown earlier, the declaration in the calling application would look like : procedure DllMessage; external 'SimpleMessageDLL.dll' the actual call to a procedure will be nothing more than DllMessage; The entire code for a Delphi form (name: Form1) with a TButton on it (name: Button1) that's calls the DLLMessage function could be: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject) ; private { Private declarations } public { Public declarations } end; var Form1: TForm1; procedure DllMessage; external 'SimpleMessageDLL.dll' implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject) ; begin DllMessage; end; end. That all! As simple as only Delphi can be. For more info on creating and using Dynamic Link Libraries from Delphi: Everything you ever wanted to know about DLLs and Delphi but didn't know where to look for answers (or were to afraid to ask). Papers, tutorials, articles, code, what, how, why, when, where...

Disable Ctrl+V shortcut pada TEdit

Terkadang anda mengiginkan agar user tidak dapat menggunakan fitur Crtl+V atatu Ctrl+C pada component yang memiliki input focus

Hal tersebut dapat dilakukan dengan cara sebagai berikut :

Misalkan kita menggunakan komponen TEdit

pastikan unit anda menggunakan class ClipBrd

uses Clipbrd, ...

Pada event Onkeydown edit1 tuliskan perintah sebagai berikut :

//disable CTRL + V ("Paste") :: handles Edit1.OnKeyDown
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState) ;
begin
___if ((ssCtrl in Shift) AND (Key = ord('V'))) then
___begin
______if Clipboard.HasFormat(CF_TEXT) then ClipBoard.Clear;
______Edit1.SelText := '"Paste" DISABLED!';
______Key := 0;
___end;
end;


Selamat mencoba semoga berhasil.....

Coloring the DBGrid

How to enhance the functionality of a TDBgrid component using colors
Adding color to your database grids will enhance the appearance and differentiate the importance of certain rows or columns within the database. Since the DBGrid is a great user interface tool for displaying data, this article will focus on questions like "How do I change the color of particular row / column / cell in a DBGrid?" Preparations This article assumes that you know how to connect a database to DBGrid component. The easiest way to accomplish this is to use the Database Form Wizard. Select the employee.db from DBDemos alias. Select all fields except EmpNo. Note: if you do not wont to work with the BDE, consider the chapters of the Free Database Course For Beginner Delphi Developers - Focus on ADO. Coloring Columns The first (and the easiest) thing you can do, to visually enhance the user interface, is to color individual column in the data-aware grid. We will accomplish this through TColumns property of the grid. Select the grid component in the form and invoke the Columns editor by double clicking on the grid's Columns property in the Object Inspector. For more information on Columns editor look for "Columns editor: creating persistent columns" in your Delphi help files. Now, everything you have to do is to specify the background color of the cells of the particular column. For text foreground color, see the font property. This is what I have done, after few clicks... You have to agree that this is much better that the standard black'n'white grid (of course, use colors if you really need them). Coloring Rows If you want to color the selected row in a DBGrid but you don't want to use the dgRowSelect option because you want to be able to edit the data you should use the DBGrid.OnDrawColumnCell event. This technique demonstrates how to dynamically change the color of text in a DBGrid: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>36000 then DBGrid1.Canvas.Font.Color:=clMaroon; DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 36 thousand, its row is displayed in Maroon colored text. Next technique demonstrates how to dynamically change the color of row in a DBGrid: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>36000 then DBGrid1.Canvas.Brush.Color:=clWhite; DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 36 thousand, its row is displayed in White. Coloring Cells And finally: if you want to change the background color of the cells of the particular column (+ text foreground color), this is what you have to do: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>40000 then begin DBGrid1.Canvas.Font.Color:=clWhite; DBGrid1.Canvas.Brush.Color:=clBlack; end; if DataCol = 4 then //4 th column is 'Salary' DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 40 thousand, its Salary cell is displayed in Black and text is displayed in White. Conclusion Techniques described in this article can really distinguish you from others, but be careful: too much coloring is too much... Now, when I look, there are far too much colors in these examples. How about graphics?

Setting Default Printer di Delphi

procedure SetDefaultPrinter(PrinterName: String) ;
var
___j: Integer;
___Device : PChar;
___Driver : Pchar;
___Port : Pchar;
___HdeviceMode: Thandle;
___aPrinter : TPrinter;
begin
___Printer.PrinterIndex := -1;
___getmem(Device, 255) ;
___getmem(Driver, 255) ;
___getmem(Port, 255) ;
___aPrinter := TPrinter.create;
___for j := 0 to Printer.printers.Count-1 do
___begin
______if Printer.printers[j] = PrinterName then
______begin___
_________aprinter.printerindex := i;
_________aPrinter.getprinter(device, driver, port, HdeviceMode) ;
_________StrCat(Device, ',') ;___
_________StrCat(Device, Driver ) ;
_________StrCat(Device, Port ) ;
_________WriteProfileString('windows', 'device', Device) ;
_________StrCopy( Device, 'windows' ) ;
_________SendMessage(HWND_BROADCAST, WM_WININICHANGE,0, Longint(@Device)) ;
______end;
___end;
___Freemem(Device, 255) ;
___Freemem(Driver, 255) ;
___Freemem(Port, 255) ;___
___aPrinter.Free;
end;

Change Printer Orientation Setup

You cannot change printer property during print document. But you can interrupt print process to change properties and run print again from the necessary line. uses Printers;
...
procedure TForm1.Button1Click(Sender: TObject) ;
var
___F, F2: TextFile;
___k, j: Integer;
begin
___AssignPrn(F) ;
___Rewrite(F) ;
___Writeln(F, RichEdit1.Lines[0]) ;
___for k:=1 to RichEdit1.Lines.Count-1 do
___begin
______if Printer.PageNumber<2>then
_________Writeln(F, RichEdit1.Lines[k]) ;
______if Printer.PageNumber>1 then
______begin
_________CloseFile(F) ;
_________Break;
______end;
___end;

___AssignPrn(F2) ;
___Printer.Orientation:=poLandscape;

___Rewrite(F2) ;
___for j:=i to RichEdit1.Lines.Count-1 do
______Writeln(F2, RichEdit1.Lines[j]) ;
___CloseFile(F2) ;
end;