Mengkosongkan DBDateTimePicker

Terkadang kita ingin menyimpan data kosong / NULL ke dalam kolom dengan tipe DATE.
Pada saat kita menggunakan komponen DBDateTimePicker, dan sudah terlanjur memilih tanggal, maka ada dua cara untuk membuat kosong datanya
1. Dengan cara mendelete secara manual, klik pada kolom DBDateTimePicker kemudian blok tanggal yang ada, tekan tombol delete.
2. Dengan cara script
Contoh pada event beforepost :
input code berikut ini :

    tbMaster.FieldByName('tukartt_date').AsVariant := null;
    tbMaster.FieldByName('due_date').AsVariant := null;

Semoga membantu.
Thanks

Get Computer Net Name and User Windows

function GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
  Result := buffer
  else
  Result := ''
end;

Function GetUserFromWindows: string;
Var
  UserName : string;
  UserNameLen : Dword;
Begin
  UserNameLen := 255;
  SetLength(userName, UserNameLen) ;
  If GetUserName(PChar(UserName), UserNameLen) Then
  Result := Copy(UserName,1,UserNameLen - 1)
  Else
  Result := 'Unknown';
End;

Get Serial Hard Disk

function GetHardDiskSerial(const DriveLetter: Char): string; 
var 
  NotUsed: DWORD; 
  VolumeFlags: DWORD; 
  VolumeInfo: array[0..MAX_PATH] of Char; 
  VolumeSerialNumber: DWORD; 
begin 
  GetVolumeInformation(PChar(DriveLetter + ':\'), 
  nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed, 
  VolumeFlags, nil, 0); 
  Result := Format('Label = %s VolSer = %8.8X', 
  [VolumeInfo, VolumeSerialNumber]) 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ShowMessage(GetHardDiskSerial('c')); 
end;

Clear "Documents" menu

uses
  Shlobj;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
  SHAddToRecentDocs(SHARD_PATH, nil);
end;

Bmp To Jpg and Jpg To Bmp

uses Jpeg;

procedure Bmp2Jpeg(const BmpFileName, JpgFileName: string);
var
 Bmp: TBitmap;
 Jpg: TJPEGImage;
begin
 Bmp := TBitmap.Create;
 Jpg := TJPEGImage.Create;
 try
   Bmp.LoadFromFile(BmpFileName);
   Jpg.Assign(Bmp);
   Jpg.SaveToFile(JpgFileName);
 finally
   Jpg.Free;
   Bmp.Free;
 end;
end;

procedure Jpeg2Bmp(const BmpFileName, JpgFileName: string);
var
 Bmp: TBitmap;
 Jpg: TJPEGImage;
begin
 Bmp := TBitmap.Create;
 Jpg := TJPEGImage.Create;
 try
   Jpg.LoadFromFile(JpgFileName);
   Bmp.Assign(Jpg);
   Bmp.SaveToFile(BmpFileName);
 finally
   Jpg.Free;
   Bmp.Free;
 end;
end;

Set Header Caption With IniFile

Uses
  ... IniFiles;


procedure SetHeader(Grid: TDBGrid; Table: String);
var vIniFile : TIniFile;
    i : integer;
    Str : String;
    DSource : TDataSource;
begin
  vIniFile := TIniFile.Create('C:\Coba.Ini');
  Str := vIniFile.ReadString(UPPERCASE(Table)+
           '-JUMLAH','JMLKOLOM','0');
  DSource := Grid.DataSource;
  for i := 0 to StrToInt(Str)-1 do
  begin
    Grid.Columns.Add;
    Grid.Columns[i].FieldName :=
      DSource.DataSet.Fields[i].FieldName;
    Grid.Columns[i].Title.Caption :=
       vIniFile.ReadString(UPPERCASE(Table)+
       '-HEADER',Grid.Columns[i].FieldName,'');
  end;
end;

Penggunaan
  SetHeader(DBGrid1,'Biodata');

Contoh Isi IniFile

[BIODATA-JUMLAH]
JMLKOLOM=2

[BIODATA-HEADER]
NO_=No
___NIK____=NIK

Keterangan :
BIODATA adalah nama table
BIODATA-JUMLAH adalah jumlah kolom yang ingin ditampilkan
BIODATA-HEADER adalah nama kolom dan caption yang akan ditampilkan

Terbilang

unit Konversi;

interface

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

  function Convert(vString : String):String;
  function ReadNumber(vString : String):string;
  function GetNumber(vNum : Integer):String;

var
  FValue : String;
  FResult : String;
  FCurrency : String;

implementation

function GetNumber(vNum : Integer):String;
begin
  case vNum of
  1 : Result := 'satu ';
  2 : Result := 'dua ';
  3 : Result := 'tiga ';
  4 : Result := 'empat ';
  5 : Result := 'lima ';
  6 : Result := 'enam ';
  7 : Result := 'tujuh ';
  8 : Result := 'delapan ';
  9 : Result := 'sembilan ';
  0 : Result := '';
  end;
end;

function ReadNumber(vString : String):string;
var level,len,j,i,vawal,awal,akhir,dgt : Integer;
    str,bil,digit,lvl,temp2 : String;
begin
  len := length(vString);
  str := vString;
  //cari level
  level := len div 3;
  if len mod 3 <> 0 then
    level := level + 1;
  //baca per 3 digit
  for i := 1 to level do
  begin
    vawal := 0;
    akhir := len - ((i-1)*3);
    awal := akhir - 3 + 1;
    if awal <= 0 then
      awal := 1;
    vString := copy(str,awal,akhir-awal+1);
    if length(vString) < 3 then
      akhir := length(vString)
    else
      akhir := 3;
    awal := 1;
    while akhir >= awal do
    begin
      dgt := akhir - awal + 1;
      bil := GetNumber(StrToInt(vString[awal]));
      case dgt of
      1 : digit := '';
      2 : digit := 'puluh ';
      3 : digit := 'ratus ';
      end;
      //pengujian angka 10 dan 11
      if dgt in [1,2] then
      begin
        if (StrToInt(vString[awal]+vString[awal+1]) >= 10) and
           (StrToInt(vString[awal]+vString[awal+1]) < 20) then
        begin
          if (akhir - awal + 1 > 1) then
          begin
            if (StrToInt(vString[awal]) = 1) and
               (StrToInt(vString[awal+1]) in [0,1]) then
              bil := 'se'
            else if (StrToInt(vString[awal]) = 1) and
                    (StrToInt(vString[awal+1]) > 1) then
              bil := GetNumber(StrToInt(vString[awal+1]));
          end;

          if StrToInt(vString[akhir]) <> 0 then
          begin
            bil := bil + 'belas ';
            digit := '';
            vawal := awal + 1;
          end
          else
          begin
            vawal := awal + 1;
          end;
        end;
      end;
      if (((i = 2) and (awal=1) and (akhir = 1)) or
         ((akhir > 1) and (StrToInt(vString[1]) = 1) and
         (dgt = 3))) and (StrToInt(vString[awal]) = 1) then
        bil := 'se';

      if (StrToInt(vString[awal]) = 0) then
        digit := '';

      Temp2 := Temp2 + bil + digit;
      awal := awal + 1 + vawal;
      vawal := 0;
    end;
    case i of
    1 : lvl := '';
    2 : lvl := 'ribu ';
    3 : lvl := 'juta ';
    4 : lvl := 'milliar ';
    5 : lvl := 'trilliun ';
    6 : lvl := 'billiun ';
    end;

    if StrToInt(vString) <> 0 then
    begin
      if (StrToInt(vString) = 1) and (i = 2) then
        Temp2 := 'seribu '
      else
        Temp2 := Temp2 + lvl;
    end;
    Result := Temp2 + Result;
    Temp2 := '';
  end;
  if (length(vString) = 1) and (vString = '0') then
    Result := 'nol ';
end;

function Convert(vString : String):String;
var i,koma : Integer;
    temp : string;
begin
  koma := pos('.',vString);
  if koma <> 0 then
  begin
    for i := 1 to 2 do
    begin
      if i = 1 then
      begin
        temp := copy(vString,1,koma-1);
        Result := ReadNumber(temp);
        Result := FResult + 'koma ';
      end
      else
      begin
        temp := copy(vString,koma+1,length(vString));
        FResult := FResult + ReadNumber(temp);
      end;
    end;
  end
  else
    Result := ReadNumber(vString);
  Result := Result + 'rupiah';
end;

end.

Calling Control Panel Applets

function RunControlPanelApplet(sAppletFileName : string): integer;
begin 
  Result := WinExec(PChar('rundll32.exe shell32.dll,'+
                  'Control_RunDLL '+sAppletFileName),SW_SHOWNORMAL);
end;

access.cpl: Accessibility Properties
appwiz.cpl: Add/Remove Programs Properties
desk.cpl: Display Properties
intl.cpl: Regional Settings Properties
joy.cpl: Joystick Properties
main.cpl: Mouse Properties
mmsys.cpl: Multimedia Properties
modem.cpl: Modems Properties
sysdm.cpl: System Properties
timedate.cpl: Time/Date Properties 

Load Dynamic Dll

function LoadAndRunDLLProcedure(sDLL,sFunc : string):boolean;
type
  TFunc_Start = procedure;
var
  Func_Start : TFunc_Start;
  hDll : THandle;
  FuncPtr : TFarProc;
  sMsg : string;
begin
  Result := False;
  hDll := LoadLibrary(PChar(sDLL));
  if(hDll > 32)then
  begin
    FuncPtr := GetProcAddress(hDll,PChar(sFunc));
    @Func_Start := FuncPtr;
    if(nil <> @Func_Start)then
    begin
      Func_Start;
      Result := True;
    end
    else
    begin
      sMsg := 'DLL entry point ' + sFunc + ' not found';
      MessageBox(0, PChar( sMsg ), 'Error',MB_OK );
    end;
    FreeLibrary( hDll );
  end
  else
  begin
    sMsg := 'File ' + sDLL + ' not found';
    MessageBox(0, PChar( sMsg ), 'Error',MB_OK );
  end;
end;

example :
LoadAndRunDLLProcedure('MyStuff.DLL','HelloWorld');

Create DBGrid that shows images

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
var
  Bmp: TBitmap;
begin
  if Field is TGraphicField then
  begin
    try
      Bmp:=TBitmap.Create;
      Bmp.Assign(Field);
      DBGrid1.Canvas.StretchDraw(Rect, Bmp);
    finally
      Bmp.Free;
    end
  end
  else
    DBGrid1.DefaultDrawDataCell(Rect, Field, State);
end;

Close Others Application

procedure TForm1.Button1Click(Sender: TObject);
var
  MyHandle: THandle;
begin
  MyHandle:=FindWindow(nil, 'Delphi Help');
  SendMessage(MyHandle, WM_CLOSE, 0, 0);
end;

Delphi FAQ

This blog is used to give information about Borland Delphi Programming. The content of this blog is multi difficulty, because everybody that like programming have a different level.I hope this blog can help everybody.

If there is an idea, send to fset2006@gmail.com