Tips dan Trik Delphi - Form

Menambahkan font tanpa install / Form / Windows / Delphi 7 - XE

AddFontResource('c:\ FONTS\ MyFont.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Menguji agar tidak duplikat entry pada listbox / Form / Windows Android / Delphi 7 - XE

function StrIsInList(sl :TStrings; s : string; bCaseSensitive : boolean ) : boolean;
var
    n : integer;
begin
    Result := False;
    if (not bCaseSensitive) then
    s := LowerCase(s);
    for n := 0 to (sl.Count - 1) do
    begin
        if((bCaseSensitive and (s = LowerCase(sl.Strings[n]))) or(s = sl.Strings[n])) then
        begin
            Result := True;
            Exit;
        end;
    end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
     if (not StrIsInList(ListBox1.Items, Edit1.Text, True)) then
         ListBox1.Items.Add(Edit1.Text);
end;

Memberi warna aktif pada komponen edit / Form / Windows / Delphi 7 - XE

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;

Menjaga form jalan pada background / Form / Windows / Delphi 7 - XE

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;

Membuat form bulat / Form / Windows / Delphi 7 - XE

procedure TForm1.FormCreate(Sender: TObject);
var
  R: HRgn;
  a: integer;
begin
  a      := -25;
  Height := 500;
  Width  := 550;
  R      := CreateEllipticRgn(-a, - a, Width - 45, Height - 45);
  SetWindowRgn(Handle, R, True);
end;

Membuat tulisan miring / Form / Windows / Delphi 7 - XE

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

Mengirimkan perintah control seperti hotkey / Form / Windows / Delphi 7 - XE


procedure PostKeyEx32(key: Word; const shift: TShiftState; specialkey: Boolean);
type
  TShiftKeyInfo = record
    shift: Byte;
    vkey: Byte;
  end;
  ByteSet = set of 0..7;
const
  shiftkeys: array [1..3] of TShiftKeyInfo = (
    (shift: Ord(ssCtrl) ; vkey: VK_CONTROL),
    (shift: Ord(ssShift) ; vkey: VK_SHIFT),
    (shift: Ord(ssAlt) ; vkey: VK_MENU)
  );
var
  flag: DWORD;
  bShift: ByteSet absolute shift;
  j: Integer;
begin
  for j := 1 to 3 do
  begin
    if shiftkeys[j].shift in bShift then
      keybd_event(
        shiftkeys[j].vkey, MapVirtualKey(shiftkeys[j].vkey, 0), 0, 0
    );
  end;
  if specialkey then
    flag := KEYEVENTF_EXTENDEDKEY
  else
    flag := 0;

  keybd_event(key, MapvirtualKey(key, 0), flag, 0);
  flag := flag or KEYEVENTF_KEYUP;
  keybd_event(key, MapvirtualKey(key, 0), flag, 0);

  for j := 3 downto 1 do
  begin
    if shiftkeys[j].shift in bShift then
      keybd_event(shiftkeys[j].vkey,MapVirtualKey(shiftkeys[j].vkey, 0),KEYEVENTF_KEYUP,0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
       // Simulate PRINTSCREEN - snapshot of the full screen
  PostKeyEx32(VK_SNAPSHOT, [], False) ;

  // Simulate PRINTSCREEN - snapshot of the active window
  PostKeyEx32(VK_SNAPSHOT, [ssAlt], False) ;

  // Simulate Spacebar key
  PostKeyEx32(VK_space, [], False) ;// ( I changed this)

  // Simulate Alt+F4 - close active window
   PostKeyEx32(VK_F4, [ssAlt], False) ;
end;

Membuat function peringatan / Form / Windows / Delphi 7 - XE


function Peringatanku(isi:String):word;
Begin
    Application.RestoreTopMosts;
    MessageDlg(isi, mtWarning, [mbOk],0);
    Application.RestoreTopMosts;
end;

Membuat dialog pertanyaan / Form / Windows / Delphi 7 - XE


function Pertanyaanku(isi:String):word;
Begin
    Application.RestoreTopMosts;
    if MessageDlg(isi, mtConfirmation, [mbYes, mbNo],0) = mrYes Then
    begin
         Result := mryes;
    end else
    begin
         Result := mrNo;
    end;
    Application.RestoreTopMosts;
end;

Menampilkan sebuah pesan / Form / Windows / Delphi 7 - XE



procedure Pesanku(Title, Text: string);
begin
  MessageBoxEx(
    0, PChar(Text), PChar(Title),
    MB_OK or MB_TOPMOST or MB_SERVICE_NOTIFICATION, 0);
end;

//atau
function Pesanku(isi:String):word;
Begin
    Application.RestoreTopMosts;
    MessageDlg(isi, mtInformation, [mbOK], 0);
    Application.RestoreTopMosts;
end;

Tips dan Trik Delphi - Form

Kategori