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;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit1.PasswordChar = #0 tHEN
Begin
Edit1.PasswordChar := '#';
End ELSE
Edit1.PasswordChar := #0;
end;
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;
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;
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;
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;
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;
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;
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;
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;