+62 812-1171-5379 Fast Respond

Tips dan Trik Delphi - Tool

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;

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;

Membuat log history program / Tool / Windows / Delphi 7 - XE
Uses Dateutils;

Procedure Simpanlog(isiStr : String);
var
   NamaFile: TextFile;
   yyyymmdd, Pathfile : String;
Begin
     yyyymmdd := copy(datetostr(now), 7,4) + copy(datetostr(now), 4,2) + copy(datetostr(now), 1,2);
     Pathfile := ExtractFilePath(Application.ExeName) + yyyymmdd + '.txt';
     if FileExists(Pathfile) Then
     Begin
          AssignFile(NamaFile, Pathfile);
          Append(NamaFile);
     End else
     Begin
          AssignFile(NamaFile, Pathfile);
          ReWrite(NamaFile);
     End;
     Writeln(NamaFile, isiStr +' '+ datetimetostr(now));
     CloseFile(NamaFile);
End;
Truncate setelah koma / Tool / Windows / Delphi 7 - XE
Function TForm1.Format_trunced(nilai : Double; digitkoma : byte) : String;
Begin
     result := Format('%.'+ Inttostr(digitkoma) +'f', [nilai]);
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit2.Text := Format_trunced(Strtofloat(Edit1.text), 2);
end;

Cara memasukkan data pada listview / Tool / Windows / Delphi 7 - XE
procedure TForm1.Button2Click(Sender: TObject);
var i : byte;
    ItemBaru : TListItem;
begin
     i := 0;
     ListView1.ViewStyle := vsReport;
     for i := 1 to 3 do
     Begin
          ItemBaru := ListView1.Items.Add;
          ItemBaru.Caption := ('Fathon Sugiharta');
          ItemBaru.SubItems.Add('Malang');
          ItemBaru.SubItems.Add('Blimbing');
          ItemBaru.SubItems.Add('081211715379');
     End;
end;

Konversi detik ke menit dan jam / Tool / Windows / Delphi 7 - XE
function konversidetikkemenitjam(AMinutes: Integer): string;
const
  HOURSPERDAY = 8;
var
  Days: Integer;
  Hours: Integer;
  Minutes: Integer;
begin
  if (AMinutes > 0) then
  begin
    Hours   := AMinutes div 60;
    Minutes := AMinutes mod 60;
    Days    := Hours div HOURSPERDAY;
    Hours   := Hours mod HOURSPERDAY;
  end
  else
  begin
    Hours   := 0;
    Minutes := 0;
    Days    := 0;
  end;

  Result := Format('%.2d:%.2d:%.2d', [Days, Hours, Minutes]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edit2.Text := konversidetikkemenitjam(StrToInt(Edit1.Text));
end;

Membesarkan dan mengecilkan volume audio / Tool / Windows / Delphi 7 - XE
uses MMSystem;

function GetWaveVolume(var LVol: DWORD; var RVol: DWORD): Boolean;
var
  WaveOutCaps: TWAVEOUTCAPS;
  Volume: DWORD;
begin
  Result := False;
  if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
    if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
    begin
      Result := WaveOutGetVolume(WAVE_MAPPER, @Volume) = MMSYSERR_NOERROR;
      LVol   := LoWord(Volume);
      RVol   := HiWord(Volume);
    end;
end;

function SetWaveVolume(const AVolume: DWORD): Boolean;
var
  WaveOutCaps: TWAVEOUTCAPS;
begin
  Result := False;
  if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
    if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
      Result := WaveOutSetVolume(WAVE_MAPPER, AVolume) = MMSYSERR_NOERROR;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  LVol: Word;
  RVol: Word;
begin
  LVol := SpinEdit1.Value;  // max. is 65535
  RVol := SpinEdit2.Value;  // max. is 65535
  SetWaveVolume(MakeLong(LVol, RVol));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  LVol: DWORD;
  RVol: DWORD;
begin
  if GetWaveVolume(LVol, RVol) then
  begin
    SpinEdit1.Value := LVol;
    SpinEdit2.Value := RVol;
  end;
end;