Custom MessageDlg: Centered Message

Salah seorang pejuang Delphi menanggapi artikel saya mengenai Custom MessageDlg. Ybs menanyakan apakah mungkin teks pesan pada MessageDlg diubah perataannya, yaitu rata tengah (Ridwan’s Comment).

Dan tanpa babibu lagi, berikut cuplikan gambar aksinya:

Teks MessageDlg Rata Tengah

Lalu bagaimana triknya? Seperti yang telah saya utarakan pada tanggapan artikel tersebut, ada beberapa cara, salah satunya adalah dengan CodeRedirect. CodeRedirect merupakan teknik membelokkan (mengganti alamat tujuan) pemanggilan suatu blok kode program ke menuju blok kode yang dikehendaki. Dengan demikian blok kode yang dibelokkan tidak pernah dieksekusi.

Berhubung saya lagi malas ber-panjang-lebar cas cis cus, jadi silahkan dipahami dan dinikmati kode sumber yang saya sajikan.

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: CustomMessageDlgCenteredUnit.pas, released on 2008-08-12

The Initial Developer of the Original Code is Bayu Prasetio
Portions created by Bayu Prasetio are Copyright (C) 2008 Bayu Prasetio.
Portions created by Andreas Hausladen are Copyright (C) Andreas Hausladen
All Rights Reserved.
-----------------------------------------------------------------------------}

{-----------------------------------------------------------------------------
  Perhatian :
    Apa yang tertera pada kode sumber ini sebaiknya dipahami terlebih dahulu,
    jangan asal 'copy-paste' dan melakukan protes jika tidak sesuai dengan
    keinginan.

    Yang perlu saya tekankan adalah, bahwa materi yang terdapat dalam kode
    sumber ini sekedar demo, 'proof-of-concept' untuk mendukung eksplorasi
    mengatur MessageDlg sampai ke batas yang Anda tentukan sendiri berdasarkan
    imajinasi dan kreativitas Anda. Dan tentu saja harapan saya adalah Anda
    dapat mengeksplorasi dan mengembangkan jauh lebih baik dari yang ada di
    demo ini.
-----------------------------------------------------------------------------}

unit CustomMessageDlgCenteredUnit;

interface

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

type
  TForm1 = class(TForm)
    btnCentered: TButton;
    mmoLegend: TMemo;
    procedure btnCenteredClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function MessageDlgCentered(const Msg: string; DlgType: TMsgDlgType;
    Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------
//   taken from bpCodeReplacement
//   Portions created by Andreas Hausladen
//------------------------------------------------------------------------------
type
  TInjectRec = packed record
    Jump: Byte;
    Offset: Integer;
  end;

  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;   //$FF25
    Addr: ^Pointer;
  end;

  PWin9xDebugThunk = ^TWin9xDebugThunk;
  TWin9xDebugThunk = packed record
    PUSH: Byte;    // $68
    Addr: Pointer;
    JMP: Byte;     // $E9
    Offset: Integer;
  end;

function IsWin9xDebugThunk(Addr: Pointer): Boolean;
begin
  Result := (Addr <> nil) and (PWin9xDebugThunk(Addr).PUSH = $68) and
                              (PWin9xDebugThunk(Addr).JMP = $E9);
end;

function GetActualAddr(Proc: Pointer): Pointer;
begin
  if Proc <> nil then
  begin
    if (SysUtils.Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
      Proc := PWin9xDebugThunk(Proc).Addr;
    if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
      Result := PAbsoluteIndirectJmp(Proc).Addr^
    else
      Result := Proc;
  end
  else
    Result := nil;
end;

procedure CodeRedirect(Proc: Pointer; NewProc: Pointer);
var
  OldProtect: Cardinal;
begin
  if Proc = nil then
    Exit;
  Proc := GetActualAddr(Proc);
  if VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(TInjectRec), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    TInjectRec(Proc^).Jump := $E9;
    TInjectRec(Proc^).Offset := Integer(NewProc) - (Integer(Proc) + SizeOf(TInjectRec));
    VirtualProtectEx(GetCurrentProcess, Proc, SizeOf(TInjectRec), OldProtect, @OldProtect);
  end;
end;

//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
//   Centering Message
//------------------------------------------------------------------------------
function MessageDlgCentered(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;
var
  ALabel : TComponent;
begin
  with Dialogs.CreateMessageDialog(Msg, DlgType, Buttons) do
  try
    ALabel := FindComponent('Message');
    if ALabel <> nil then
      TLabel(ALabel).Alignment := taCenter;
    Result := ShowModal;
  finally
    Free;
  end
end;

//------------------------------------------------------------------------------

procedure TForm1.btnCenteredClick(Sender: TObject);
begin
  MessageDlg('Pesan ini ditulis rata tengah' + #13#10 +
             'Silahkan eksplorasi lebih lanjut. :)', mtInformation, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // belokkan setiap pemanggilan MessageDlg ke fungsi MessageDlgCentered
  CodeRedirect(@Dialogs.MessageDlg, @MessageDlgCentered);
end;

end.

Semoga bermanfaat.