Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZMDlg19;
  2.  
  3. (*
  4.   ZMDlg19.pas - DialogBox with buttons from language strings
  5.   TZipMaster19 VCL by Chris Vleghert and Eric W. Engler
  6.   v1.9
  7.   Copyright (C) 2009  Russell Peters
  8.  
  9.  
  10.   This library is free software; you can redistribute it and/or
  11.   modify it under the terms of the GNU Lesser General Public
  12.   License as published by the Free Software Foundation; either
  13.   version 2.1 of the License, or (at your option) any later version.
  14.  
  15.   This library is distributed in the hope that it will be useful,
  16.   but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18.   Lesser General Public License (licence.txt) for more details.
  19.  
  20.   You should have received a copy of the GNU Lesser General Public
  21.   License along with this library; if not, write to the Free Software
  22.   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  23.  
  24.   contact: problems AT delphizip DOT org
  25.   updates: http://www.delphizip.org
  26.  
  27.   modified 2009-02-02
  28.   --------------------------------------------------------------------------- *)
  29.  
  30. interface
  31.  
  32. uses
  33.   Classes, Windows, Forms, Dialogs, { Buttons, } StdCtrls;
  34.  
  35. // High word = $10 or TMsgDlgType, low word = context
  36. const
  37.   zmtWarning = $100000;
  38.   zmtError = $110000;
  39.   zmtInformation = $120000;
  40.   zmtConfirmation = $130000;
  41.   zmtPassword = $140000;
  42.  
  43. type
  44.   TZipDialogBox = class(TForm)
  45.   private
  46.     AvDlgUnits: TPoint;
  47.     BeepId: integer;
  48.     ctx: integer;
  49.     // DxText: TLabel;
  50.     IconID: pChar;
  51.     PwdEdit: TEdit;
  52.     function GetDlgType: integer;
  53.     function GetPWrd: string;
  54.     procedure SetPwrd(const Value: string);
  55.   public
  56.     constructor CreateNew2(Owner: TComponent; context: integer); virtual;
  57.     procedure Build(const Title, Msg: String; Btns: TMsgDlgButtons
  58. {$IFNDEF UNICODE}; IsUTF8: boolean {$ENDIF});
  59.     function ShowModal: integer; override;
  60.     property DlgType: integer read GetDlgType;
  61.     property PWrd: string read GetPWrd write SetPwrd;
  62.   end;
  63.  
  64. implementation
  65.  
  66. uses SysUtils, Graphics, ExtCtrls, Controls,
  67. {$IFNDEF UNICODE}
  68.   ZMUTF819,
  69. {$ENDIF}
  70.   ZMMsg19, ZMMsgStr19;
  71. {$INCLUDE '.\ZipVers19.inc'}
  72.  
  73. const
  74.   SZmdText = 'zmdText';
  75.   SImage = 'Image';
  76.   SZmdEdit = 'zmdEdit';
  77.   SZMDlg19 = 'ZMDlg19%d';
  78.   { Maximum no. of characters in a password; Do not change! }
  79.   PWLEN = 80;
  80.  
  81.   { TMsgDlgBtn = (
  82.     mbYes,
  83.     mbNo,
  84.     mbOK,
  85.     mbCancel,
  86.     mbAbort,
  87.     mbRetry,
  88.     mbIgnore,
  89.     mbAll,
  90.     mbNoToAll,
  91.     mbYesToAll,
  92.     mbHelp,
  93.     mbClose
  94.     ); }
  95. type
  96. {$IFDEF UNICODE}
  97.   TZWideLabel = TLabel;
  98. {$ELSE}
  99.  
  100.   TZWideLabel = class(TLabel)
  101.   private
  102.     WideText: WideString;
  103.     procedure SetCaption(Value: WideString);
  104.   protected
  105.     procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
  106.   public
  107.     // published
  108.     property Caption: WideString read WideText write SetCaption;
  109.   end;
  110.  
  111. procedure TZWideLabel.DoDrawText(var Rect: TRect; Flags: Longint);
  112. begin
  113.   Canvas.Font := Font;
  114.  
  115.   // HOTFIX-MARX-C
  116.   if DrawTextW(Canvas.Handle, pWideChar(WideText), Length(WideText), Rect, Flags) = 0 then
  117.   begin
  118.     ExtTextOutW(Canvas.Handle, 0,0, ETO_CLIPPED, @Rect, pWideChar(WideText), Length(WideText), nil);
  119.   end;
  120. end;
  121.  
  122. procedure TZWideLabel.SetCaption(Value: WideString);
  123. begin
  124.   WideText := Value;
  125.   Invalidate; // repaint
  126. end;
  127. {$ENDIF}
  128.  
  129. procedure TZipDialogBox.Build(const Title, Msg: String; Btns: TMsgDlgButtons
  130. {$IFNDEF UNICODE}; IsUTF8: boolean {$ENDIF});
  131. const
  132.   kHMargin = 8;
  133.   kVMargin = 8;
  134.   kHSpacing = 10;
  135.   kVSpacing = 10;
  136.   kBWidth = 50;
  137.   kBHeight = 14;
  138.   kBSpacing = 4;
  139.   ModalResults: array [TMsgDlgBtn] of integer =
  140.     (mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
  141.     mrYesToAll, 0 {$IFDEF UNICODE}, 0 {$ENDIF});
  142. var
  143.   ALeft: integer;
  144.   B: TMsgDlgBtn;
  145.   BHeight: integer;
  146.   BSpacing: integer;
  147.   ButtonCount: integer;
  148.   ButtonGroupWidth: integer;
  149.   BWidth: integer;
  150.   CancelButton: TMsgDlgBtn;
  151.   CHeight: integer;
  152.   CWidth: integer;
  153.   DefaultButton: TMsgDlgBtn;
  154.   DxText: TZWideLabel;
  155.   HMargin: integer;
  156.   HSpacing: integer;
  157.   i: integer;
  158.   IconTextHeight: integer;
  159.   IconTextWidth: integer;
  160.   N: TButton;
  161.   tabOrdr: integer;
  162.   TextRect: TRect;
  163.   tx: integer;
  164.   VMargin: integer;
  165.   VSpacing: integer;
  166.   wdth: integer;
  167. {$IFDEF UNICODE}
  168.   wmsg: String;
  169. {$ELSE}
  170.   wmsg: WideString;
  171. {$ENDIF}
  172.   X: integer;
  173.   Y: integer;
  174. begin
  175.   BiDiMode := Application.BiDiMode;
  176.   BorderStyle := bsDialog;
  177.   Canvas.Font := Font;
  178.   if Title = '' then
  179.     Caption := Application.Title
  180.   else
  181.     Caption := Title;
  182. {$IFNDEF UNICODE}
  183.   if IsUTF8 then
  184.     wmsg := UTF8ToWide(Msg, -1)
  185.   else
  186. {$ENDIF}
  187.     wmsg := Msg;
  188.   HMargin := MulDiv(kHMargin, AvDlgUnits.X, 4);
  189.   VMargin := MulDiv(kVMargin, AvDlgUnits.Y, 8);
  190.   HSpacing := MulDiv(kHSpacing, AvDlgUnits.X, 4);
  191.   VSpacing := MulDiv(kVSpacing, AvDlgUnits.Y, 8);
  192.   BWidth := MulDiv(kBWidth, AvDlgUnits.X, 4);
  193.   if mbOK in Btns then
  194.     DefaultButton := mbOK
  195.   else if mbYes in Btns then
  196.     DefaultButton := mbYes
  197.   else
  198.     DefaultButton := mbRetry;
  199.   if mbCancel in Btns then
  200.     CancelButton := mbCancel
  201.   else if mbNo in Btns then
  202.     CancelButton := mbNo
  203.   else
  204.     CancelButton := mbOK;
  205.   ButtonCount := 0;
  206.   tabOrdr := 1;
  207.   if DlgType = zmtPassword then
  208.     tabOrdr := 2;
  209.   for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
  210.     if (B <> mbHelp) and (B in Btns) then
  211.     begin
  212.       Inc(ButtonCount);
  213.       N := TButton.Create(Self);
  214.       // with N do
  215.       begin
  216.         N.Name := Format(SZMDlg19, [ButtonCount]);
  217.         N.Parent := Self;
  218.         N.Caption := LoadZipStr(ZB_Yes + ord(B));
  219.         N.ModalResult := ModalResults[B];
  220.         if B = DefaultButton then
  221.           N.Default := True;
  222.         if B = CancelButton then
  223.           N.Cancel := True;
  224.         N.TabStop := True;
  225.         N.TabOrder := tabOrdr;
  226.         Inc(tabOrdr);
  227.       end;
  228.       TextRect := Rect(0, 0, 0, 0);
  229.       Windows.DrawText(Canvas.Handle, pChar(N.Caption), -1, TextRect,
  230.         DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
  231.           DrawTextBiDiModeFlagsReadingOnly);
  232.       // with TextRect do
  233.       wdth := TextRect.Right - TextRect.Left + 8;
  234.       if wdth > BWidth then
  235.         BWidth := wdth;
  236.     end;
  237.   BHeight := MulDiv(kBHeight, AvDlgUnits.Y, 8);
  238.   BSpacing := MulDiv(kBSpacing, AvDlgUnits.X, 4);
  239.   SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
  240.   // HOTFIX-MARX-C
  241.   if DrawTextW(Canvas.Handle, pWideChar(wmsg), Length(wmsg) + 1, TextRect,
  242.     DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
  243.       DrawTextBiDiModeFlagsReadingOnly) = 0 then
  244.   begin
  245.     TextRect.Bottom := BHeight; // Alas, we cannot know the real height
  246.   end;
  247.   IconTextWidth := TextRect.Right;
  248.   IconTextHeight := TextRect.Bottom;
  249.   if IconID <> NIL then
  250.   begin
  251.     Inc(IconTextWidth, 32 + HSpacing);
  252.     if IconTextHeight < 32 then
  253.       IconTextHeight := 32;
  254.   end;
  255.   ButtonGroupWidth := 0;
  256.   if ButtonCount <> 0 then
  257.     ButtonGroupWidth := BWidth * ButtonCount + BSpacing * (ButtonCount - 1);
  258.   if IconTextWidth > ButtonGroupWidth then
  259.     CWidth := IconTextWidth
  260.   else
  261.     CWidth := ButtonGroupWidth;
  262.   CHeight := IconTextHeight + BHeight;
  263.   if DlgType = zmtPassword then
  264.   begin
  265.     if CWidth < (PWLEN * AvDlgUnits.X) then
  266.       CWidth := PWLEN * AvDlgUnits.X;
  267.     PwdEdit := TEdit.Create(Self);
  268.     with PwdEdit do
  269.     begin
  270.       Name := SZmdEdit;
  271.       Text := '';
  272.       Parent := Self;
  273.       PasswordChar := '*';
  274.       MaxLength := PWLEN;
  275.       TabOrder := 1;
  276.       TabStop := True;
  277.       BiDiMode := Self.BiDiMode;
  278.       ALeft := IconTextWidth - TextRect.Right + HMargin;
  279.       if UseRightToLeftAlignment then
  280.         ALeft := CWidth - ALeft - Width;
  281.       tx := PWLEN * AvDlgUnits.X;
  282.       if tx < TextRect.Right then
  283.         tx := TextRect.Right;
  284.       SetBounds(ALeft, IconTextHeight + VMargin + VSpacing, tx, 15);
  285.     end;
  286.     ActiveControl := PwdEdit;
  287.     CHeight := CHeight + PwdEdit.Height + VMargin;
  288.   end;
  289.   ClientWidth := CWidth + (HMargin * 2);
  290.   ClientHeight := CHeight + VSpacing + VMargin * 2;
  291.   Left := (Screen.Width div 2) - (Width div 2);
  292.   Top := (Screen.Height div 2) - (Height div 2);
  293.   if IconID <> NIL then
  294.     with TImage.Create(Self) do
  295.     begin
  296.       Name := SImage;
  297.       Parent := Self;
  298.       Picture.Icon.Handle := LoadIcon(0, IconID);
  299.       SetBounds(HMargin, VMargin, 32, 32);
  300.     end;
  301.   // DxText := TLabel.Create(Self);
  302.   DxText := TZWideLabel.Create(Self);
  303.   with DxText do
  304.   begin
  305.     Name := SZmdText;
  306.     Parent := Self;
  307.     WordWrap := True;
  308.     Caption := wmsg; // msg;
  309.     BoundsRect := TextRect;
  310.     BiDiMode := Self.BiDiMode;
  311.     ALeft := IconTextWidth - TextRect.Right + HMargin;
  312.     if UseRightToLeftAlignment then
  313.       ALeft := Self.ClientWidth - ALeft - Width;
  314.     SetBounds(ALeft, VMargin, TextRect.Right, TextRect.Bottom);
  315.   end;
  316.   X := (ClientWidth - ButtonGroupWidth) div 2;
  317.   Y := IconTextHeight + VMargin + VSpacing;
  318.   if DlgType = zmtPassword then
  319.     Inc(Y, PwdEdit.Height + VSpacing);
  320.   for i := 0 to pred(ComponentCount) do
  321.     if Components[i] is TButton then
  322.       with Components[i] as TButton do
  323.       begin
  324.         SetBounds(X, Y, BWidth, BHeight);
  325.         Inc(X, BWidth + BSpacing);
  326.       end;
  327. end;
  328.  
  329. constructor TZipDialogBox.CreateNew2(Owner: TComponent; context: integer);
  330. const
  331.   IconIDs: array [0 .. 4] of pChar = (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK,
  332.     IDI_QUESTION, NIL);
  333.   BeepIDs: array [0 .. 4] of integer = (MB_ICONEXCLAMATION, MB_ICONHAND,
  334.     MB_ICONASTERISK, MB_ICONQUESTION, 0);
  335. var
  336.   buf: array [0 .. 65] of Char;
  337.   i: integer;
  338.   NonClientMetrics: TNonClientMetrics;
  339. begin
  340.   inherited CreateNew(Owner, 0);
  341.   NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  342.   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  343.     Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
  344.   ctx := context;
  345.   if DlgType = 0 then
  346.     ctx := ctx or zmtWarning;
  347.   for i := 0 to 25 do
  348.   begin
  349.     buf[i] := Char(ord('A') + i);
  350.     buf[i + 27] := Char(ord('a') + i);
  351.   end;
  352.   buf[26] := ' ';
  353.   buf[52] := ' ';
  354.   for i := 53 to 63 do
  355.     buf[i] := Char(ord('0') + i - 53);
  356.   buf[64] := #0;
  357.   GetTextExtentPoint(Canvas.Handle, buf, 64, TSize(AvDlgUnits));
  358.   AvDlgUnits.X := AvDlgUnits.X div 64;
  359.   i := (DlgType shr 16) and 7;
  360.   if i > 4 then
  361.     i := 4;
  362.   IconID := IconIDs[i];
  363.   BeepId := BeepIDs[i];
  364. end;
  365.  
  366. function TZipDialogBox.GetDlgType: integer;
  367. begin
  368.   Result := ctx and $1F0000;
  369. end;
  370.  
  371. function TZipDialogBox.GetPWrd: string;
  372. begin
  373.   if assigned(PwdEdit) then
  374.     Result := PwdEdit.Text
  375.   else
  376.     Result := '';
  377. end;
  378.  
  379. procedure TZipDialogBox.SetPwrd(const Value: string);
  380. begin
  381.   if assigned(PwdEdit) and (Value <> PwdEdit.Text) then
  382.     PwdEdit.Text := Value;
  383. end;
  384.  
  385. function TZipDialogBox.ShowModal: integer;
  386. begin
  387.   if BeepId <> 0 then
  388.     MessageBeep(BeepId);
  389.   Result := inherited ShowModal;
  390. end;
  391.  
  392. end.
  393.