+62 812-1171-5379 Fast Respond

Tips dan Trik Delphi

Menampilkan format kalender indonesia / Tool / Windows / Delphi 7 - XE
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    DateTimePicker1: TDateTimePicker;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  namaBulan: array[1..12] of string =
    ( 'Januari', 'Februari', 'Maret', 'April', 'Mei', 'Juni', 'Juli', 'Agustus', 'September', 'Oktober', 'November', 'Desember');

implementation

{$R *.dfm}

Procedure ReplaceLongMonthNamesWithIndonesian;
var i : integer;
begin     
    for i:=1 to High(namaBulan) do
    Begin
	LongMonthNames[i] := namaBulan[i];
    End;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
     ReplaceLongMonthNamesWithIndonesian;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     edit1.text := FormatDateTime('dd MMMM yyyy', DateTimePicker1.Date);
end;

end.


Insert delete baris Stringgrid / Tool / Windows / Delphi 7 - XE
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TStringGridHack = class(TStringGrid)
  protected
    procedure DeleteRow(ARow: Longint); reintroduce;
    procedure InsertRow(ARow: Longint);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TStringGridHack.DeleteRow(ARow: Longint);
var
  i : integer;
begin
     i := ARow;
     For i := arow to RowCount - 1  do
     Begin
          Rows[i].Assign(Rows[i+1]);
     End;
     RowCount := RowCount - 1;
end;

procedure TStringGridHack.InsertRow(ARow: Longint);
var
  GemRow: Integer;
begin
    GemRow := Row;
    while ARow < FixedRows do
    Inc(ARow);

    RowCount := RowCount + 1;
    MoveRow(RowCount - 1, ARow);
    Row := GemRow;
    Rows[Row].Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     StringGrid1.Cells[0,0] := 'NO';
     StringGrid1.Cells[1,0] := 'NAMA';
     StringGrid1.Cells[2,0] := 'ALAMAT';
     StringGrid1.Cells[3,0] := 'TELP';

     StringGrid1.Cells[0,1] := '1';
     StringGrid1.Cells[1,1] := 'Tonny Malang';
     StringGrid1.Cells[2,1] := '1';
     StringGrid1.Cells[3,1] := '1';

     StringGrid1.Cells[0,2] := '2';
     StringGrid1.Cells[1,2] := 'Fathon';
     StringGrid1.Cells[2,2] := '2';
     StringGrid1.Cells[3,2] := '2';

     StringGrid1.Cells[0,3] := '3';
     StringGrid1.Cells[1,3] := 'Sugiharta';
     StringGrid1.Cells[2,3] := '3';
     StringGrid1.Cells[3,3] := '3';

     StringGrid1.Cells[0,4] := '4';
     StringGrid1.Cells[1,4] := 'Kursus Delphi';
     StringGrid1.Cells[2,4] := '4';
     StringGrid1.Cells[3,4] := '4';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     TStringGridHack(StringGrid1).DeleteRow(StringGrid1.Row);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     TStringGridHack(StringGrid1).InsertRow(StringGrid1.Row);
end;


end.


Menampilkan nama font pada combobox / Tool / Windows / Delphi 7 - XE
procedure TForm1.FormCreate(Sender: TObject);
begin
     ComboBox1.Items.Assign(Screen.Fonts);
end;

Melihat numlock dan capslock on off dengan timer / Tool / Windows / Delphi 7 - XE
procedure TForm1.Timer1Timer(Sender: TObject);
var keystate : TKeyboardState;
begin
     GetKeyboardState(keystate);
     if keystate[vk_numlock] = 0 Then
     Begin
          Label1.Caption := 'NUMLOCK OFF';
     End else
     Begin
          Label1.Caption := 'NUMLOCK ON';
     End;

     if keystate[vk_capital] = 0 Then
     Begin
          Label2.Caption := 'CAPSLOCK OFF';
     End else
     Begin
          Label2.Caption := 'CAPSLOCK ON';
     End;
end;

Menampilkan password mode show / Tool / Windows / Delphi 7 - XE
procedure TForm1.Button1Click(Sender: TObject);
begin
     if Edit1.PasswordChar = #0 tHEN
     Begin
          Edit1.PasswordChar := '#';
     End ELSE
          Edit1.PasswordChar := #0;
end;

Membuat set tanggal 1 dan tanggal akhir bulan / Tool / Windows / Delphi 7 - XE
function Akhirbulan(Tahun, bulan : Smallint) : Smallint;
Const DaysinMonth : array[1..12] of smallint = (31,28,31,30,31,30,31,31,30,31,30,31);
Begin
    Result := DaysInMonth[bulan];
    if (bulan = 2) and IsLeapYear(Tahun) Then
       inc(Result);
End;

procedure TForm1.FormCreate(Sender: TObject);
var dari, sampai : String;
begin
     dari := '01/'+ FormatFloat('##', MonthOf(now)) +'/' + FormatFloat('##', YearOf(now));
     sampai := inttostr(Akhirbulan(YearOf(now),MonthOf(now))) +'/'+ FormatFloat('##', MonthOf(now)) +'/' + FormatFloat('##', YearOf(now));
     DateTimePicker1.Date := strtodate(dari);
     DateTimePicker2.Date := strtodate(sampai);
end;

Membuat tulisan miring / Form / Windows / Delphi 7 - XE
procedure TForm1.Button1Click(Sender: TObject);
var
  lf : TLogFont;
  tf : TFont;
begin
  with Form1.Canvas do begin
    Font.Name := 'Arial';
    Font.Size := 24;
    tf := TFont.Create;
    tf.Assign(Font);
    GetObject(tf.Handle, sizeof(lf), @lf);
    lf.lfEscapement := 450;
    lf.lfOrientation := 450;
    tf.Handle := CreateFontIndirect(lf);
    Font.Assign(tf);
    tf.Free;
    TextOut(20, Height div 2, 'Rotated Text!');
  end;
end;

Menghentikan saat proses looping / Tool / Windows / Delphi 7 - XE
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
var
  LoopAborted: Boolean;
  i: Integer;
begin
  LoopAborted := False;
  i := 0;
  repeat
        Caption := IntToStr(i);
        Application.ProcessMessages;

        if GetKeyState(VK_Escape) and 128 = 128 then
        begin
            LoopAborted := True;
            Break; // perintah ini untuk menghentikan perintah looping
        end;

        Inc(i);
  until i = 100000;
  if LoopAborted = true then
    ShowMessage('Anda menghetikan looping!');
end;

Memecah kode atau splitting code / Tool / Windows / Delphi 7 - XE
Koding ini digunakan apabila anda ingin memecah mecah kode nomor surat, contohnya kode berikut : SPP-2307-0081 Tujuannya adalah akan mengelompokkan data dan diurutkan, berikut kodingnya :
Var
   Kode1_Var, Kode2_var, Kode3_var : String;

Procedure TForm1.Pecahkode(Str : String; pemisah: string);
Var i : byte;  Step : byte; strtemp : string;
begin
     i := 0; step := 0; Kode1_Var := ''; Kode2_var := ''; Kode3_var := '';
     For i := 1 to length(Str) Do
     Begin
           strtemp := copy(Str, i,1);
           if step = 0 Then
           Begin
                if strtemp <> pemisah Then
                Begin
                     Kode1_var := Kode1_var + strtemp;
                End else
                     Inc(step);
           End else
           if step = 1 Then
           Begin
                if strtemp <> pemisah Then
                Begin
                     Kode2_var := Kode2_var + strtemp;
                End Else
                     Inc(step);
           End Else
           if step = 2 Then
           Begin
                if strtemp <> pemisah Then
                Begin
                     Kode3_var := Kode3_var + strtemp;
                End else
                     Inc(step);
           End;
     End;
End;

Menyimpan history atau log format file ini / Files / Windows / Delphi 7 - XE
 uses inifiles;
procedure fnLog(FMessage : String);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create(fnGetLoc + 'log.ini');
  try
    ini.WriteString('Log', FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ' ', ' ' + FMessage);
  finally
    ini.DisposeOf;
  end;
end;

procedure fnLog(FKey, FMessage : String);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create(fnGetLoc + 'log.ini');
  try
    ini.WriteString('Log', FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ' ', ' [' + FKey + '] - ' + FMessage);
  finally
    ini.DisposeOf;
  end;
end;