unit ZMDlg19;
(*
ZMDlg19.pas - DialogBox with buttons from language strings
TZipMaster19 VCL by Chris Vleghert and Eric W. Engler
v1.9
Copyright (C) 2009 Russell Peters
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License (licence.txt) for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
contact: problems AT delphizip DOT org
updates: http://www.delphizip.org
modified 2009-02-02
--------------------------------------------------------------------------- *)
interface
uses
Classes, Windows, Forms, Dialogs, { Buttons, } StdCtrls;
// High word = $10 or TMsgDlgType, low word = context
const
zmtWarning = $100000;
zmtError = $110000;
zmtInformation = $120000;
zmtConfirmation = $130000;
zmtPassword = $140000;
type
TZipDialogBox = class(TForm)
private
AvDlgUnits: TPoint;
BeepId: integer;
ctx: integer;
// DxText: TLabel;
IconID: pChar;
PwdEdit: TEdit;
function GetDlgType: integer;
function GetPWrd: string;
procedure SetPwrd(const Value: string);
public
constructor CreateNew2(Owner: TComponent; context: integer); virtual;
procedure Build(const Title, Msg: String; Btns: TMsgDlgButtons
{$IFNDEF UNICODE}; IsUTF8: boolean {$ENDIF});
function ShowModal: integer; override;
property DlgType: integer read GetDlgType;
property PWrd: string read GetPWrd write SetPwrd;
end;
implementation
uses SysUtils, Graphics, ExtCtrls, Controls,
{$IFNDEF UNICODE}
ZMUTF819,
{$ENDIF}
ZMMsg19, ZMMsgStr19;
{$INCLUDE '.\ZipVers19.inc'}
const
SZmdText = 'zmdText';
SImage = 'Image';
SZmdEdit = 'zmdEdit';
SZMDlg19 = 'ZMDlg19%d';
{ Maximum no. of characters in a password; Do not change! }
PWLEN = 80;
{ TMsgDlgBtn = (
mbYes,
mbNo,
mbOK,
mbCancel,
mbAbort,
mbRetry,
mbIgnore,
mbAll,
mbNoToAll,
mbYesToAll,
mbHelp,
mbClose
); }
type
{$IFDEF UNICODE}
TZWideLabel = TLabel;
{$ELSE}
TZWideLabel = class(TLabel)
private
WideText: WideString;
procedure SetCaption(Value: WideString);
protected
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
public
// published
property Caption: WideString read WideText write SetCaption;
end;
procedure TZWideLabel.DoDrawText(var Rect: TRect; Flags: Longint);
begin
Canvas.Font := Font;
// HOTFIX-MARX-C
if DrawTextW(Canvas.Handle, pWideChar(WideText), Length(WideText), Rect, Flags) = 0 then
begin
ExtTextOutW(Canvas.Handle, 0,0, ETO_CLIPPED, @Rect, pWideChar(WideText), Length(WideText), nil);
end;
end;
procedure TZWideLabel.SetCaption(Value: WideString);
begin
WideText := Value;
Invalidate; // repaint
end;
{$ENDIF}
procedure TZipDialogBox.Build(const Title, Msg: String; Btns: TMsgDlgButtons
{$IFNDEF UNICODE}; IsUTF8: boolean {$ENDIF});
const
kHMargin = 8;
kVMargin = 8;
kHSpacing = 10;
kVSpacing = 10;
kBWidth = 50;
kBHeight = 14;
kBSpacing = 4;
ModalResults: array [TMsgDlgBtn] of integer =
(mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
mrYesToAll, 0 {$IFDEF UNICODE}, 0 {$ENDIF});
var
ALeft: integer;
B: TMsgDlgBtn;
BHeight: integer;
BSpacing: integer;
ButtonCount: integer;
ButtonGroupWidth: integer;
BWidth: integer;
CancelButton: TMsgDlgBtn;
CHeight: integer;
CWidth: integer;
DefaultButton: TMsgDlgBtn;
DxText: TZWideLabel;
HMargin: integer;
HSpacing: integer;
i: integer;
IconTextHeight: integer;
IconTextWidth: integer;
N: TButton;
tabOrdr: integer;
TextRect: TRect;
tx: integer;
VMargin: integer;
VSpacing: integer;
wdth: integer;
{$IFDEF UNICODE}
wmsg: String;
{$ELSE}
wmsg: WideString;
{$ENDIF}
X: integer;
Y: integer;
begin
BiDiMode := Application.BiDiMode;
BorderStyle := bsDialog;
Canvas.Font := Font;
if Title = '' then
Caption := Application.Title
else
Caption := Title;
{$IFNDEF UNICODE}
if IsUTF8 then
wmsg := UTF8ToWide(Msg, -1)
else
{$ENDIF}
wmsg := Msg;
HMargin := MulDiv(kHMargin, AvDlgUnits.X, 4);
VMargin := MulDiv(kVMargin, AvDlgUnits.Y, 8);
HSpacing := MulDiv(kHSpacing, AvDlgUnits.X, 4);
VSpacing := MulDiv(kVSpacing, AvDlgUnits.Y, 8);
BWidth := MulDiv(kBWidth, AvDlgUnits.X, 4);
if mbOK in Btns then
DefaultButton := mbOK
else if mbYes in Btns then
DefaultButton := mbYes
else
DefaultButton := mbRetry;
if mbCancel in Btns then
CancelButton := mbCancel
else if mbNo in Btns then
CancelButton := mbNo
else
CancelButton := mbOK;
ButtonCount := 0;
tabOrdr := 1;
if DlgType = zmtPassword then
tabOrdr := 2;
for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
if (B <> mbHelp) and (B in Btns) then
begin
Inc(ButtonCount);
N := TButton.Create(Self);
// with N do
begin
N.Name := Format(SZMDlg19, [ButtonCount]);
N.Parent := Self;
N.Caption := LoadZipStr(ZB_Yes + ord(B));
N.ModalResult := ModalResults[B];
if B = DefaultButton then
N.Default := True;
if B = CancelButton then
N.Cancel := True;
N.TabStop := True;
N.TabOrder := tabOrdr;
Inc(tabOrdr);
end;
TextRect := Rect(0, 0, 0, 0);
Windows.DrawText(Canvas.Handle, pChar(N.Caption), -1, TextRect,
DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
// with TextRect do
wdth := TextRect.Right - TextRect.Left + 8;
if wdth > BWidth then
BWidth := wdth;
end;
BHeight := MulDiv(kBHeight, AvDlgUnits.Y, 8);
BSpacing := MulDiv(kBSpacing, AvDlgUnits.X, 4);
SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
// HOTFIX-MARX-C
if DrawTextW(Canvas.Handle, pWideChar(wmsg), Length(wmsg) + 1, TextRect,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly) = 0 then
begin
TextRect.Bottom := BHeight; // Alas, we cannot know the real height
end;
IconTextWidth := TextRect.Right;
IconTextHeight := TextRect.Bottom;
if IconID <> NIL then
begin
Inc(IconTextWidth, 32 + HSpacing);
if IconTextHeight < 32 then
IconTextHeight := 32;
end;
ButtonGroupWidth := 0;
if ButtonCount <> 0 then
ButtonGroupWidth := BWidth * ButtonCount + BSpacing * (ButtonCount - 1);
if IconTextWidth > ButtonGroupWidth then
CWidth := IconTextWidth
else
CWidth := ButtonGroupWidth;
CHeight := IconTextHeight + BHeight;
if DlgType = zmtPassword then
begin
if CWidth < (PWLEN * AvDlgUnits.X) then
CWidth := PWLEN * AvDlgUnits.X;
PwdEdit := TEdit.Create(Self);
with PwdEdit do
begin
Name := SZmdEdit;
Text := '';
Parent := Self;
PasswordChar := '*';
MaxLength := PWLEN;
TabOrder := 1;
TabStop := True;
BiDiMode := Self.BiDiMode;
ALeft := IconTextWidth - TextRect.Right + HMargin;
if UseRightToLeftAlignment then
ALeft := CWidth - ALeft - Width;
tx := PWLEN * AvDlgUnits.X;
if tx < TextRect.Right then
tx := TextRect.Right;
SetBounds(ALeft, IconTextHeight + VMargin + VSpacing, tx, 15);
end;
ActiveControl := PwdEdit;
CHeight := CHeight + PwdEdit.Height + VMargin;
end;
ClientWidth := CWidth + (HMargin * 2);
ClientHeight := CHeight + VSpacing + VMargin * 2;
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
if IconID <> NIL then
with TImage.Create(Self) do
begin
Name := SImage;
Parent := Self;
Picture.Icon.Handle := LoadIcon(0, IconID);
SetBounds(HMargin, VMargin, 32, 32);
end;
// DxText := TLabel.Create(Self);
DxText := TZWideLabel.Create(Self);
with DxText do
begin
Name := SZmdText;
Parent := Self;
WordWrap := True;
Caption := wmsg; // msg;
BoundsRect := TextRect;
BiDiMode := Self.BiDiMode;
ALeft := IconTextWidth - TextRect.Right + HMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
SetBounds(ALeft, VMargin, TextRect.Right, TextRect.Bottom);
end;
X := (ClientWidth - ButtonGroupWidth) div 2;
Y := IconTextHeight + VMargin + VSpacing;
if DlgType = zmtPassword then
Inc(Y, PwdEdit.Height + VSpacing);
for i := 0 to pred(ComponentCount) do
if Components[i] is TButton then
with Components[i] as TButton do
begin
SetBounds(X, Y, BWidth, BHeight);
Inc(X, BWidth + BSpacing);
end;
end;
constructor TZipDialogBox.CreateNew2(Owner: TComponent; context: integer);
const
IconIDs: array [0 .. 4] of pChar = (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK,
IDI_QUESTION, NIL);
BeepIDs: array [0 .. 4] of integer = (MB_ICONEXCLAMATION, MB_ICONHAND,
MB_ICONASTERISK, MB_ICONQUESTION, 0);
var
buf: array [0 .. 65] of Char;
i: integer;
NonClientMetrics: TNonClientMetrics;
begin
inherited CreateNew(Owner, 0);
NonClientMetrics.cbSize := sizeof(NonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
ctx := context;
if DlgType = 0 then
ctx := ctx or zmtWarning;
for i := 0 to 25 do
begin
buf[i] := Char(ord('A') + i);
buf[i + 27] := Char(ord('a') + i);
end;
buf[26] := ' ';
buf[52] := ' ';
for i := 53 to 63 do
buf[i] := Char(ord('0') + i - 53);
buf[64] := #0;
GetTextExtentPoint(Canvas.Handle, buf, 64, TSize(AvDlgUnits));
AvDlgUnits.X := AvDlgUnits.X div 64;
i := (DlgType shr 16) and 7;
if i > 4 then
i := 4;
IconID := IconIDs[i];
BeepId := BeepIDs[i];
end;
function TZipDialogBox.GetDlgType: integer;
begin
Result := ctx and $1F0000;
end;
function TZipDialogBox.GetPWrd: string;
begin
if assigned(PwdEdit) then
Result := PwdEdit.Text
else
Result := '';
end;
procedure TZipDialogBox.SetPwrd(const Value: string);
begin
if assigned(PwdEdit) and (Value <> PwdEdit.Text) then
PwdEdit.Text := Value;
end;
function TZipDialogBox.ShowModal: integer;
begin
if BeepId <> 0 then
MessageBeep(BeepId);
Result := inherited ShowModal;
end;
end.