Tips dan Trik Delphi - Form

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  protected
       procedure CreateParams(var Params: TCreateParams); override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
    inherited;
    with Params.WindowClass do
        style := style or CS_NOCLOSE;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
     ShowWindow(Application.Handle, SW_HIDE);
     SetWindowLong(Application.Handle, GWL_EXSTYLE,
     getWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW );
     ShowWindow( Application.Handle, SW_SHOW );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   lf : TLogFont;
   tf : TFont;
begin
    with Form1.Canvas do
    begin
        Font.Name := 'Arial';
        Font.Size := 24;
        tf := TFont.Create;
        try
            tf.Assign(Font);
            GetObject(tf.Handle,sizeof(lf), @lf);
            lf.lfEscapement := 450;
            lf.lfOrientation := 450;
            tf.Handle := CreateFontIndirect(lf);
            Font.Assign(tf);
        finally
           tf.Free;
        end;
        TextOut(20, Height div 2, 'Rotated Text!');
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    FullRgn, ClientRgn, ButtonRgn: THandle;
    Margin, X, Y: Integer;
begin
    Margin := (Width - ClientWidth) div 2;
    FullRgn:= CreateRectRgn(0, 0,Width, Height);
    X := Margin;
    Y := Height- ClientHeight - Margin;
    ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
    CombineRgn(FullRgn,FullRgn, ClientRgn, RGN_DIFF);
    X := X + Button1.Left;
    Y := Y + Button1.Top;
    ButtonRgn := CreateRectRgn
    (X, Y, X + Button1.Width, Y + Button1.Height);
    CombineRgn(FullRgn,FullRgn,ButtonRgn,RGN_OR);
    SetWindowRgn(Handle, FullRgn,True);
end;

procedure SystemKeys(Disable: Boolean);
varOldVal :LongInt;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING,
Word(Disable), @OldVal, 0);
end;

procedure TForm1.PrintIt(Sender:TObject);
var
   PrintBuf: TextFile;
   i : integer;
begin
    AssignPrn(PrintBuf);
    Rewrite(PrintBuf);
    try
        for i := 0to Memo1.Lines.Count-1 do
        WriteLn(PrintBuf, Memo1.Lines[i]);
    finally
        CloseFile(PrintBuf);
    end;
End;


procedure TForm1.Button1Click(Sender: TObject);
begin
     PrintIt(self);
end;

procedure TForm1.OpenDialog1Show(Sender: TObject);
begin
     {"OPEN" - > "Do Open"}
      SetDlgItemText (GetParent (Opendialog1.Handle),
      IDOK, PChar ('&Do Open'));
      {"Cancel" - > "No, Dismiss"}
      SetDlgItemText (GetParent (Opendialog1.Handle),
      IDCANCEL, PChar ('&No, Dismiss'));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     OpenDialog1.Execute;
end;

  private
    { Private declarations }
     InsertOn : bool;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     if (Key = VK_INSERT) and (Shift = []) then
        Inserton := not InsertOn;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
     if ((Memo1.SelLength = 0) and (not InsertOn)) then
        Memo1.SelLength := 1;
end;

procedure TForm1.SetHorizontalScrollBar(lb :TListBox);
var
i, MaxWidth: integer;
begin
    MaxWidth := 0;
    for i := 0 to lb.Items.Count - 1 do
    if MaxWidth < lb.Canvas.TextWidth(lb.Items[i]) then
        MaxWidth := lb.Canvas.TextWidth(lb.Items[i]);
        SendMessage(lb.Handle, LB_SETHORIZONTALEXTENT, MaxWidth + 5, 0);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
     SetHorizontalScrollBar(ListBox1);
end;

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