Tips dan Trik Delphi

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;

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TWheelDBGrid = class(TDBGrid)
  public
    property OnMouseWheel;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TWheelDBGrid(DBGrid1).OnMouseWheel := DBGridMouseWheel;
end;

function GetNumScrollLines: Integer;
begin
  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
end;

procedure TForm1.DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Direction: Shortint;
begin
  Direction := 1;
  if WheelDelta = 0 then
    Exit
  else if WheelDelta > 0 then
    Direction := -1;

  with TDBGrid(Sender) do
  begin
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
      DataSource.DataSet.MoveBy(Direction * GetNumScrollLines);
    Invalidate;
  end;
end;

uses Comobj;

procedure TForm1.Button1Click(Sender: TObject);
var
  voice: OLEVariant;
begin
  voice := CreateOLEObject('SAPI.SpVoice');
  voice.Speak('Hello World!', 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ListBox1.Style := lbOwnerDrawVariable;
    ListBox1.ItemHeight := 20;

    ListBox1.Items.Add('Item 1');
    ListBox1.Items.Add('Item 2');
    ListBox1.Items.Add('Item 3');
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  drawRect: TRect;
begin
  with ListBox1.Canvas do
  begin
    FillRect(rect);

    drawRect.Left := rect.Left + 1;
    drawRect.Right := Rect.Left + 13;
    drawRect.Bottom := Rect.Bottom;
    drawRect.Top := Rect.Top;

    if odSelected in State then
      DrawFrameControl(Handle, drawRect, DFC_BUTTON, DFCS_BUTTONRADIO or DFCS_CHECKED)
    else
      DrawFrameControl(Handle, drawRect, DFC_BUTTON, DFCS_BUTTONRADIO);

    TextOut(15, rect.Top + 3, ListBox1.Items[Index]);
  end;
end;

  private
    { Private declarations }
    hLib2: THandle;
    DllStr1: string;
    FKeyCount: Integer;
    procedure DllMessage(var Msg: TMessage); message WM_USER + 1678;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DllMessage(var Msg: TMessage);
begin
  Inc(FKeyCount);
  Label2.Caption := Format('KeyCount: %d',[FKeyCount]);
  if (Msg.wParam = 8) Then
  Begin
       Memo1.Clear;
       Exit;
  End;
  if (Msg.wParam = 13) then
  Begin

       Exit;
  End;

  DllStr1 := DllStr1 + Chr(Msg.wParam);
  label1.Caption := DllStr1;
end;


procedure TForm1.Button1Click(Sender: TObject);
type
  TStartHook = function(MemoHandle, AppHandle: HWND): Byte;
var
  StartHook1: TStartHook;
  SHresult: Byte;
begin
    hLib2 := LoadLibrary('HookLib.dll');
    @StartHook1 := GetProcAddress(hLib2, 'StartHook');
    if @StartHook1 = nil then
      Exit;
    SHresult := StartHook1(Memo1.Handle, Handle);
    if SHresult = 0 then ShowMessage('the Key Hook was Started, good');
    if SHresult = 1 then ShowMessage('the Key Hook was already Started');
    if SHresult = 2 then ShowMessage('the Key Hook can NOT be Started, bad');
    if SHresult = 4 then ShowMessage('MemoHandle is incorrect');
    FKeyCount := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
type
  TStopHook = function: Boolean;
var
  StopHook1: TStopHook;
  hLib21: THandle;
begin
      @StopHook1 := GetProcAddress(hLib2, 'StopHook');
      if @StopHook1 = nil then
      begin
        ShowMessage('Stop Hook DLL Mem Addy not found');
        Exit;
      end;
      if StopHook1 then
        ShowMessage('Hook was stoped');
      FreeLibrary(hLib2);
      {for some reason in Win XP you need to call FreeLibrary twice
      maybe because you get 2 functions from the DLL? ?}
      FreeLibrary(hLib2);
end; 

Gunakan ilmu ini untuk kebutuhan baik


                                        

function CaseOfString(s: string; a: array of string): Integer;
begin
    Result := 0;
    while (Result < Length(a)) and (a[Result] <> s) do
      Inc(Result);
    if a[Result] <> s then
      Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    case CaseOfString(Edit1.Text, ['1', '2', '3', '4']) of
        0: Label1.Caption := 'Anda pilih 1';
        1: Label1.Caption := 'Anda pilih 2';
        2: Label1.Caption := 'Anda pilih 3';
        3: Label1.Caption := 'Anda pilih 4';
      else
        Label1.Caption := '?';
    end;
end;