Tips dan Trik Delphi - Tool

function TForm1.IsLeapYear(AYear: Integer): Boolean;
begin
      Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function TForm1.DaysPerMonth(AYear, AMonth: Integer): Integer;
const
      DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
     Result := DaysInMonth[AMonth];
     if (AMonth = 2) and IsLeapYear(AYear) then
         Inc(Result); { leap-year Feb is special }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Edthasil.Text := IntToStr(DaysPerMonth(StrToInt(EdtTahun.Text), StrToInt(EdtBulan.Text)));
end;

uses Commctrl;

{....}

const
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);

var
  hTooltip: Cardinal;
  ti: TToolInfo;
  buffer : array[0..255] of char;
  
{....}



procedure CreateToolTips(hWnd: Cardinal);
begin
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
  if hToolTip <> 0 then
  begin
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags := TTF_SUBCLASS;
    ti.hInst  := hInstance;
  end;
end;

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
  Text, Title: PChar);
var
  Item: THandle;
  Rect: TRect;
begin
  Item := hWnd;
  if (Item <> 0) and (GetClientRect(Item, Rect)) then
  begin
    lpti.hwnd := Item;
    lpti.Rect := Rect;
    lpti.lpszText := Text;
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
    FillChar(buffer, SizeOf(buffer), #0);
    lstrcpy(buffer, Title);
    if (IconType > 3) or (IconType < 0) then IconType := 0;
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateToolTips(Form1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');
end;

uses
   Commctrl;

procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
BackCL, TextCL: TColor);
const
  TOOLTIPS_CLASS = 'tooltips_class32';
  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_BALLOON = $40;
  TTF_SUBCLASS = $0010;
  TTF_TRANSPARENT = $0100;
  TTF_CENTERTIP = $0002;
  TTM_ADDTOOL = $0400 + 50;
  TTM_SETTITLE = (WM_USER + 32);
  ICC_WIN95_CLASSES = $000000FF;
type
  TOOLINFO = packed record
    cbSize: Integer;
    uFlags: Integer;
    hwnd: THandle;
    uId: Integer;
    rect: TRect;
    hinst: THandle;
    lpszText: PWideChar;
    lParam: Integer;
  end;
var
  hWndTip: THandle;
  ti: TOOLINFO;
  hWnd: THandle;
begin
  hWnd    := Control.Handle;
  hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
    0, 0, 0, 0, hWnd, 0, HInstance, nil);
  if hWndTip <> 0 then
  begin
    SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
    ti.cbSize := SizeOf(ti);
    ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
    ti.hwnd := hWnd;
    ti.lpszText := Text;
    Windows.GetClientRect(hWnd, ti.rect);
    SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
    SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
    SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
    SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowBalloonTip(Button1, 1, 'Title',
  'Balloon tooltip,http://kingron.myetang.com; updated by Calin', clBlue, clNavy);
end;

function MinimizeToTray(Handle: HWND): Boolean;
var  
  hwndTray: HWND;
  rcWindow: TRect;
  rcTray: TRect;
begin
  // Check passed window handle
  if IsWindow(Handle) then
  begin
    // Get tray handle
    hwndTray := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'TrayNotifyWnd', nil);
    // Check tray handle
    if (hwndTray = 0) then
      // Failure
      Result := False
    else
    begin
      // Get window rect and tray rect
      GetWindowRect(Handle, rcWindow);
      GetWindowRect(hwndTray, rcTray);
      // Perform the animation
      DrawAnimatedRects(Handle, IDANI_CAPTION, rcWindow, rcTray);
      // Hide the window
      ShowWindow(Handle, SW_HIDE);
    end;
  end
  else
    // Failure
    Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MinimizeToTray(Handle);
end;

procedure TForm1.ToolBar1CustomDrawButton(Sender: TToolBar;
  Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  // select color
  Sender.Canvas.Brush.Color := clAqua;

  // Paint selected color
  Sender.Canvas.Rectangle(Button.BoundsRect);
end;

procedure AM_or_PM;
begin
  if Frac(Time) = 0 then
    ShowMessage('AM')
  else
    ShowMessage('PM');
end;

function GetDateMMDDYYYY(TheDate: TDatetime):Str10;
begin
   DecodeDate(TheDate,vYY,vMM,vDD);
   Result:=IntToStr(vMM)+'/'+IntToStr(vDD)+'/'+IntToStr(vYY);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   StringGrid1.DefaultRowHeight := ComboBox1.Height;
   ComboBox1.Visible := False;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  R: TRect;
begin
  if ((ACol = 3) AND (ARow <> 0)) then
  begin
      R := StringGrid1.CellRect(ACol, ARow);
      R.Left := R.Left + StringGrid1.Left;
      R.Right := R.Right + StringGrid1.Left;
      R.Top := R.Top + StringGrid1.Top;
      R.Bottom := R.Bottom + StringGrid1.Top;
      ComboBox1.Left := R.Left + 0 ;
      ComboBox1.Top := R.Top + 0 ;
      ComboBox1.Width := (R.Right + 0 ) - R.Left;
      ComboBox1.Height := (R.Bottom + 0 ) - R.Top;
      ComboBox1.Visible := True;
      ComboBox1.SetFocus;
  end;
  CanSelect := True;
end;

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
     if key=13 Then
        StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row] := ComboBox1.Text;
end;

var
  Nilai : byte;

procedure TForm1.Button1Click(Sender: TObject);
begin
     nilai := Strtoint(Edit1.text);
     if Nilai in[1,6,9] Then
     Begin
          // jika nilai dimasukkan 1 atau 6 atau 9 maka muncul pesan ini
          ShowMessage('Ada kesamaan nilai');
     End else
     Begin
          // jika nilai dimasukkan tidak ditemukan maka muncul pesan ini
          ShowMessage('Tidak ditemukan kesamaan nilai');
     End;
end;

Type
   TNums = set of 1..9;

var
  Form1: TForm1;
  nums1, nums2, nums3, nums4, nums5, nums6 : TNums;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
     nums1 := [1,2,3];
     nums2 := [1,2,4];
     nums3 := [1,2,3,4,5,6,7,8,9];

     // Menguji kesetaraan
     if nums1 = nums2 then
     begin
          ShowMessage('nums1 =  nums2')
     end else
     begin
          ShowMessage('nums1 <> nums2');
     end;

     // Menguji ketidaksetaraan
     if nums1 <> nums3 Then
     begin
          ShowMessage('nums1 <> nums3')
     end else
          ShowMessage('nums1 =  nums3');

     // Apakah nums1 adalah dari bagian nums3?
     if nums1 <= nums3 then
     begin
          ShowMessage('nums1 bagian dari himpunan nums3')
     end else
          ShowMessage('nums1 bukan bagian dari himpunan nums3');

end;