Tips dan Trik Delphi

var
  Form1: TForm1;
  OldWidth, OldHeight: integer;

implementation

{$R *.dfm}

function TForm1.SetScreenResolution(Width, Height: integer): Longint;
var
    DeviceMode: TDeviceMode;
begin
    with DeviceMode do
    begin
        dmSize := SizeOf(TDeviceMode);
        dmPelsWidth := Width;
        dmPelsHeight := Height;
        dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    end;
    Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      SetScreenResolution(800, 600);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     SetScreenResolution(OldWidth, OldHeight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     OldWidth := GetSystemMetrics(SM_CXSCREEN);
     OldHeight := GetSystemMetrics(SM_CYSCREEN);
end;

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;

var
  Form1: TForm1;
  KomponenControl: TComponent;

implementation

{$R *.dfm}

procedure TForm1.DoActiveControl(Sender: TObject);
begin
    if assigned(KomponenControl) then
    begin
        (KomponenControl as TEdit).color := ClWhite;
        (KomponenControl as TEdit).font.color := ClBlack;
    end;
    if activeControl is TEdit then
    begin
        (activeControl as TEdit).color := clGreen;
        (activeControl as TEdit).font.color := clWhite;
        KomponenControl := activeControl as TEdit;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
      Screen.OnActiveControlChange := DoActiveControl;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
      Screen.OnActiveControlChange := nil;
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;

protected
  procedure CreateParams(var Params: TCreateParams); override;

//...

procedure TForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Assigned(Application.MainForm) then
  begin
    Params.WndParent := GetDesktopWindow;
    Params.Style := WS_CHILD;
  end;
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;

function Calculate(SMyExpression: string; digits: Byte): string;
  // Calculate a simple expression
  // Supported are:  Real Numbers, parenthesis
var
  z: Char;
  ipos: Integer;

  function StrToReal(chaine: string): Real;
  var
    r: Real;
    Pos: Integer;
  begin
    Val(chaine, r, Pos);
    if Pos > 0 then Val(Copy(chaine, 1, Pos - 1), r, Pos);
    Result := r;
  end;

  function RealToStr(inreal: Extended; digits: Byte): string;
  var
    S: string;
  begin
    Str(inreal: 0: digits, S);
    realToStr := S;
  end;

  procedure NextChar;
  var
    s: string;
  begin
    if ipos > Length(SMyExpression) then
    begin
      z := #9;
      Exit;
    end
    else
    begin
      s := Copy(SMyExpression, ipos, 1);
      z := s[1];
      Inc(ipos);
    end;
    if z = ' ' then nextchar;
  end;

  function Expression: Real;
  var
    w: Real;

    function Factor: Real;
    var
      ws: string;
    begin
      Nextchar;
      if z in ['0'..'9'] then
      begin
        ws := '';
        repeat
          ws := ws + z;
          nextchar
        until not (z in ['0'..'9', '.']);
        Factor := StrToReal(ws);
      end
      else if z = '(' then
      begin
        Factor := Expression;
        nextchar
      end
      else if z = '+' then Factor := +Factor
      else if Z = '-' then Factor := -Factor;
    end;

    function Term: Real;
    var
      W: Real;
    begin
      W := Factor;
      while Z in ['*', '/'] do
        if z = '*' then w := w * Factor
      else
        w := w / Factor;
      Term := w;
    end;
  begin
    w := term;
    while z in ['+', '-'] do
      if z = '+' then w := w + term
    else
      w := w - term;
    Expression := w;
  end;
begin
  ipos   := 1;
  Result := RealToStr(Expression, digits);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  sMyExpression: string;
begin
  sMyExpression := '12.5*6+18/3.2+2*(5-6.23)';
  ShowMessage(sMyExpression + ' = ' + Calculate(sMyExpression, 3));
end;

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