Tips dan Trik Delphi - Tool

uses Comobj;

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

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;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Application.OnHint := MyHint;
    ShowHint := True;
    Button1.Hint := 'Untuk menyimpan data';
    Button2.Hint := 'Koreksi data dan klik Simpan';
    Button3.Hint := 'Cetak pada printer';
    Edit1.Hint := 'Kode barang';
end;

procedure TForm1.MyHint(Sender: TObject);
begin
     StatusBar1.SimpleText := Application.Hint;
end;

function RandomPassword(PLen: Integer): string;
var
  str: string;
begin
    Randomize;
    str    := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
    Result := '';
    repeat
      Result := Result + str[Random(Length(str)) + 1];
    until (Length(Result) = PLen)
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     edit1.text := RandomPassword(10);
end;

function IsStrANumber(const S: string): Boolean;
var
  P: PChar;
begin
  P      := PChar(S);
  Result := False;
  while P^ <> #0 do
  begin
    if not (P^ in ['0'..'9']) then Exit;
    Inc(P);
  end;
  Result := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    if IsStrANumber('1234567890A')= true Then
       ShowMessage('Benar') else
       ShowMessage('Salah');
end;

function GetExtendedKeys(shift:TShiftState):string;
var Ctlkeys:string;
begin
      Ctlkeys:=' ';
      if ssShift in shift then
      begin
          if getkeystate(VK_LShift) < 0 then
             ctlkeys := 'Shift{Left}+'
          else if getkeystate(VK_RShift) < 0 then
             ctlkeys := 'Shift{Right}+';
      end;
      if ssAlt in shift then
      begin
          if getkeystate(VK_LMenu) < 0 then
             ctlkeys := ctlkeys+'Alt{Left}+'
          else if getkeystate(VK_RMenu) < 0 then
             ctlkeys := ctlkeys+'Alt{Right}+';
      end;
      if ssCtrl in shift then
      begin
          if getkeystate(VK_LControl) < 0 then
             ctlkeys := ctlkeys+'Ctrl{Left}+'
          else if getkeystate(VK_RControl) < 0 then
             ctlkeys := ctlkeys+'Ctrl{Right}+';
      end;
      delete(ctlkeys,length(ctlkeys),1);
      result := ctlkeys;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
   msg : string;
   keyname, ctlkeys : string;
begin
    msg:='';
    ctlkeys := GetExtendedKeys(Shift);

    if key = vk_capital then
    begin
        if 1 and getkeystate(key)>0 then
           capslock.caption:='ON'
        else
           capslock.caption:='OFF';
    end;

    if key=vk_Numlock then
    begin
        if 1 and getkeystate(key)>0 then
           numlock.caption:='ON'
        else
           numlock.caption:='OFF';
    end;

    if key=vk_Scroll then
    begin
        if 1 and getkeystate(key)>0 then
            ScrollLock.caption:='ON'
        else ScrollLock.caption:='OFF';
    end;

    key:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
var ov: TOSVersionInfo;
    vr: Integer;
begin
      ov.dwOSVersionInfoSize := SizeOf(ov);
      GetVersionEx(ov);
      if OV.dwPlatformID = VER_PLATFORM_WIN32_NT then
      begin
          vr := GetDeviceCaps(Form1.Canvas.Handle,VREFRESH);
          Label1.Caption := 'Frequence: '+ IntToStr(vr) + ' Hz';
      end;
End;

procedure TForm1.Button1Click(Sender: TObject);
var
   dc : hdc;
begin
    dc := GetDc(0);
    MoveToEx(Dc, 0, 0, nil);
    LineTo(Dc, 300, 300);
    ReleaseDc(0, Dc);
end;

  private
    { Private declarations }
  public
    { Public declarations }
    procedure hotykey(var msg:TMessage); message WM_HOTKEY;
  end;

var
  Form1: TForm1;
  id, id2 : Integer;
implementation

{$R *.dfm}

procedure TForm1.hotykey(var msg:TMessage);
begin
     if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=81) then
     begin
          ShowMessage('Ctrl + Q ya beb !');
     end;
     if (msg.LParamLo=MOD_CONTROL) and (msg.LParamHi=82) then
     begin
          ShowMessage('Ctrl + R ya beb !');
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     id := GlobalAddAtom('hotkey');
     RegisterHotKey(handle,id, mod_control, 81);
     id2 := GlobalAddAtom('hotkey2');
     RegisterHotKey(handle,id2, mod_control, 82);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     UnRegisterHotKey(handle,id);
     UnRegisterHotKey(handle,id2);
end;

vk_LButton = $01;
vk_RButton= $02;
vk_Cancel= $03;
vk_MButton = $04;
vk_Back = $08;
vk_Tab= $09;
vk_Clear = $0C;
vk_Return = $0D;
vk_Shift = $10;
vk_Control = $11;
vk_Menu = $12;
vk_Pause = $13;
vk_Capital = $14;
vk_Escape = $1B;
vk_Space = $20;
vk_Prior= $21;
vk_Next= $22;
vk_End = $23;
vk_Home = $24;
vk_Left = $25;
vk_Up= $26;
vk_Right= $27;
vk_Down = $28;
vk_Select = $29;
vk_Print= $2A;
vk_Execute= $2B;
vk_SnapShot = $2C;
vk_Copy= $2C
vk_Insert = $2D;
vk_Delete = $2E;
vk_Help = $2F;
vk_NumPad0 = $60;
vk_NumPad1 = $61;
vk_NumPad2 = $62;
vk_NumPad3 = $63;
vk_NumPad4 = $64;
vk_NumPad5 = $65;
vk_NumPad6 = $66;
vk_NumPad7 = $67;
vk_NumPad8 = $68;
vk_NumPad9 = $69;
vk_Multiply = $6A;
vk_Add = $6B;
vk_Separator = $6C;
vk_Subtract= $6D;
vk_Decimal = $6E;
vk_Divide = $6F;
vk_F1 = $70;
vk_F2 = $71;
vk_F3 = $72;
vk_F4 = $73;
vk_F5 = $74;
vk_F6 = $75;134
vk_F7 = $76;
vk_F8 = $77;
vk_F9 = $78;
vk_F10 = $79;
vk_F11 = $7A;
vk_F12 = $7B;
vk_F13 = $7C;
vk_F14 = $7D;
vk_F15 = $7E;
vk_F16 = $7F;
vk_F17 = $80;
vk_F18 = $81;
vk_F19 = $82;
vk_F20 = $83;
vk_F21 = $84;
vk_F22 = $85;
vk_F23 = $86;
vk_F24 = $87;
vk_NumLock = $90;
vk_Scroll = $91;