unit GvWinDlg;

{ unit GvWinDlg, Copr. 1994,99 Matthias K"oppe
  Graphics Vision: Windows dialog template usage

  $Id$
}

{$ifndef FPK}
{$A+,B-,F+,G+,I-,O+,P-,Q-,R-,S-,T-,V+,X+}
{$endif}

interface

{$ifdef Windows}
uses Wintypes, Objects, Drivers, Views, Validate, GvDialog, GvViews, GvValid, WinRes;
{$else}
uses Objects, Drivers, Views, Validate, GvDialog, GvViews, GvValid, WinRes;
{$endif Windows}

const
  CGrayDialog = #99#77#78#79#80#81#82#83#84#85#86#87#88#89#90#91#92#93;
  CWinLabel =  #95#95#97#98#1#1;

{ TSingleCluster is an abstract derivative of TMultiCheckBoxes, modified such
  that it will support a single button, which is linked with others in
  order to perform cluster-like functions together.

  Set the AGroup flag of one button to TRUE, and it will work as a data
  server of all buttons of the same type which have the AGroup flag clear.
  Thus, your dialog windows may include clusters whose elements can be
  positioned arbitrarily but whose data transfer is compatible with the
  standard Turbo Vision style clusters.
}

type
  PSingleCluster = ^TSingleCluster;
  TSingleCluster = object(TMultiCheckBoxes)
    Group: Boolean;
    constructor Init(var Bounds: TRect; Text: string;
      ASelNum: Byte; AFlags: Word;
      AStates: pointer; AGroup: Boolean);
    constructor Load(var S: TStream);
    function DataSize: Sw_Word; virtual;
    procedure GetData(var Rec); virtual;
    procedure GetItemRect(Item: Integer; var Extent: TRect); virtual;
    procedure Go; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function NextBtn: PSingleCluster;
    function PrevBtn: PSingleCluster;
    procedure SetData(var Rec); virtual;
    procedure Store(var S: TStream);
  end;

{ TRadioButton implements a full-featured single radio button, which can
  be linked with others.
}
  PRadioButton = ^TRadioButton;
  TRadioButton = object(TSingleCluster)
    constructor Init(var Bounds: TRect; Text: string; AGroup: Boolean);
    procedure DrawItem(Item: Integer; Down: Boolean); virtual;
    procedure GetData(var Rec); virtual;
    function GetIconNum(Id: Byte): Integer; virtual;
    procedure Go; virtual;
    function Mark(Item: Integer): Boolean; virtual;
    procedure Press(Item: Integer); virtual;
    procedure SetData(var Rec); virtual;
  End;

{ TCheckBox implements a full-featured single check box, which can be
  linked with others.
}
  PCheckBox = ^TCheckBox;
  TCheckBox = object(TSingleCluster)
    constructor Init(var Bounds: TRect; Text: string; AGroup: Boolean);
  End;

{ T3StateBox implements a full-featured 3-state box (cfTwoBits type),
  which can be linked with others.
}
  P3StateBox = ^T3StateBox;
  T3StateBox = object(TSingleCluster)
    constructor Init(var Bounds: TRect; Text: string; AGroup: Boolean);
    function DataSize: Sw_Word; virtual;
  end;

{ TRectangle object, simple rectangular static
}
  PRectangle = ^TRectangle;
  TRectangle = object(TGView)
    Color: Word;
    IsFilled: Boolean;
    constructor Init(var Bounds: TRect; AColor: Word; Filled: Boolean);
    constructor Load(var S: TStream);
    procedure Draw; virtual;
    procedure Store(var S: TStream);
  end;

{ TWinLabel object, with conforming background color
}
  PWinLabel = ^TWinLabel;
  TWinLabel = object(TLabel)
    function GetPalette: PPalette; virtual;
  end;

{ TLevel object, providing shaded levels for gray dialogs.
}
  PLevel = ^TLevel;
  TLevel = object(TGView)
    Height: Integer;
    constructor Init(var Bounds: TRect; AHeight: Integer);
    constructor Load(var S: TStream);
    procedure Draw; virtual;
    procedure Store(var S: TStream);
  end;

{ TPassInputLine object, providing hidden input
}
  PPassInputLine = ^TPassInputLine;
  TPassInputLine = object(TInputLine)
    procedure DrawText(APos, EPos: Integer); virtual;
  end;

{ TWinDlg object
}
  PWinDialog = ^TWinDialog;
  TWinDialog = object(TDialog)
    GrayBack: Boolean;
    constructor Init(var Bounds: TRect; ATitle: TTitleStr; Gray: Boolean);
    constructor RawInit;
    constructor Load(var S: TStream);
    function GetControl(id: Integer): PGView;
    {function GetHelpCtx: Word; virtual;}
    function GetPalette: PPalette; virtual;
    procedure Store(var S: TStream);
  end;

{ Store a newly created dialog in this variable, and it will be
  resized and filled with controls, instead of creating a new
  generic dialog, within LoadDialog.
}
const
  DialogTemplate: PWinDialog = nil;

{ Support Routines for user-defined class handling
}
procedure SetupInfo(Data: PDialogBoxHeader; Info: PDialogInfo);
procedure GetDialogRect(var Bounds: TRect;
  Data: PDialogBoxHeader; Info: PDialogInfo);
procedure GetControlRect(var Bounds: TRect;
  Data: PControlData; Info: PDialogInfo);
function XlatCmd(id: Word): Word;
function InsertControl(Dialog: PDialog; View: PGView): PGView;
procedure SplitRectCB(var Bounds: TRect; var Arrow: TRect);
procedure SplitRectSB(var Bounds: TRect; var HorizRect, VertRect: TRect;
  Horiz, Vert: Boolean);
function NilStrPas(s: PChar): string;
function AccessResource(Info: PDialogInfo): PStream;
procedure UnaccessResource(Info: PDialogInfo);
procedure InitWinDialog(Data: PDialogBoxHeader; Info: PDialogInfo; Gray: Boolean);

{ Init Dialog Routine
}
procedure InitDialog(Data: PDialogBoxHeader; Info: PDialogInfo);
procedure InitBorDlg(Data: PDialogBoxHeader; Info: PDialogInfo);

{ Init Control Routines
}
procedure InitButton(Data: PControlData; Info: PDialogInfo);
procedure InitStatic(Data: PControlData; Info: PDialogInfo);
procedure InitEdit(Data: PControlData; Info: PDialogInfo);
procedure InitListbox(Data: PControlData; Info: PDialogInfo);
procedure InitCombobox(Data: PControlData; Info: PDialogInfo);
procedure InitScrollbar(Data: PControlData; Info: PDialogInfo);
procedure InitBorBtn(Data: PControlData; Info: PDialogInfo);
procedure InitBorShade(Data: PControlData; Info: PDialogInfo);
procedure InitLevelZero(Data: PControlData; Info: PDialogInfo);

{ Link Routines
}
procedure LinkLabel(Link: PGView; Control: PLabel);
procedure LinkIcon(Link: PGView; Control: PIcon);

{ Wake Dialog Routine
}
procedure WakeDialog(Info: PDialogInfo);

{ Validator Classes
}
const
  ctValidator = 1;

type
  TValidatorProc = function(const Args: array of PChar): PValidator;

function InitFilterValidator(const Args: array of PChar): PValidator;
function InitRangeValidator(const Args: array of PChar): PValidator;
function InitPictureValidator(const Args: array of PChar): PValidator;
function InitRealValidator(const Args: array of PChar): PValidator;

function CreateValidator(Title: PChar): PValidator;

{ Class Registration Records
}
const
  classDialog: TClassRec = (
    ClassId:  nil;
    Init:   @InitDialog);

{$ifndef FPK}
  classButton: TClassRec = (
    ClassId:  cl_Button;
    Init:   @InitButton);

  classStatic: TClassRec = (
    ClassId:  cl_Static;
    Init:   @InitStatic);

  classEdit: TClassRec = (
    ClassId:  cl_Edit;
    Init:   @InitEdit);

  classListbox: TClassRec = (
    ClassId:  cl_Listbox;
    Init:   @InitListbox);

  classComboBox: TClassRec = (
    ClassId:  cl_ComboBox;
    Init:   @InitComboBox);

  classScrollbar: TClassRec = (
    ClassId:  cl_Scrollbar;
    Init:   @InitScrollbar);
{$endif}

  classBorDlg: TClassRec = (
    ClassId:  'BorDlg';
    Init:   @InitBorDlg);

  classBorCheck: TClassRec = (
    ClassId:  'BorCheck';
    Init:   @InitButton);

  classBorRadio: TClassRec = (
    ClassId:  'BorRadio';
    Init:   @InitButton);

  classBorShade: TClassRec = (
    ClassId:  'BorShade';
    Init:   @InitBorShade);

  classBorBtn: TClassRec = (
    ClassId:  'BorBtn';
    Init:   @InitBorBtn);

  classBorStatic: TClassRec = (
    ClassId:  'BorStatic';
    Init:   @InitStatic);

  classGvLevelZero: TClassRec = (
    ClassId:  'GvLevelZero';
    Init:   @InitLevelZero);

  classFilterValidator: TClassRec = (
    ClassId:  'Filter';	{ Filter(CharacterMask) }
    Init:   @InitFilterValidator;
    TypeId: ctValidator);

  classRangeValidator: TClassRec = (
    ClassId:  'Range';	{ Range(MinValue, MaxValue) }
    Init:   @InitRangeValidator;
    TypeId: ctValidator);

  classPictureValidator: TClassRec = (
    ClassId:  'Picture';	{ Picture(Picture) or Picture(Picture, AutoFill) }
    Init:   @InitPictureValidator;
    TypeId: ctValidator);

  classRealValidator: TClassRec = (
    ClassId:  'Real';	{ Real(Decimals) }
    Init:   @InitRealValidator;
    TypeId: ctValidator);

{ Stream Registration Records
}
const
  RCheckBox: TStreamRec = (
    ObjType: 205;
    VmtLink: Ofs(TypeOf(TCheckBox)^);
    Load:    @TCheckBox.Load;
    Store:   @TCheckBox.Store);

  RRadioButton: TStreamRec = (
    ObjType: 206;
    VmtLink: Ofs(TypeOf(TRadioButton)^);
    Load:    @TRadioButton.Load;
    Store:   @TRadioButton.Store);

  R3StateBox: TStreamRec = (
    ObjType: 207;
    VmtLink: Ofs(TypeOf(T3StateBox)^);
    Load:    @T3StateBox.Load;
    Store:   @T3StateBox.Store);

  RRectangle: TStreamRec = (
    ObjType: 208;
    VmtLink: Ofs(TypeOf(TRectangle)^);
    Load:    @T3StateBox.Load;
    Store:   @T3StateBox.Store);

  RWinLabel: TStreamRec = (
    ObjType: 209;
    VmtLink: Ofs(TypeOf(TWinLabel)^);
    Load:    @TWinLabel.Load;
    Store:   @TWinLabel.Store);

  RLevel: TStreamRec = (
    ObjType: 210;
    VmtLink: Ofs(TypeOf(TLevel)^);
    Load:    @TLevel.Load;
    Store:   @TLevel.Store);

  RWinDialog: TStreamRec = (
    ObjType: 211;
    VmtLink: Ofs(TypeOf(TWinDialog)^);
    Load:    @TWinDialog.Load;
    Store:   @TWinDialog.Store);

  RPassInputLine: TStreamRec = (
    ObjType: 212;
    VmtLink: Ofs(TypeOf(TPassInputLine)^);
    Load:    @TPassInputLine.Load;
    Store:   @TPassInputLine.Store);

{ Register classes and types routine
}
procedure RegisterGvWinDlg;

implementation

{$ifdef FPK}
uses ExtGraph, Bgi, Strings, GvBWCC, GvBitmap;
{$else}
{$ifdef Windows}
uses ExtGraph, WinGr, Strings, GvBWCC, GvBitmap;
{$else Windows}
uses ExtGraph, MetaGr, MyFonts, Strings, GvBWCC, GvBitmap;
{$endif Windows}
{$endif}

{ TSingleCluster object *****************************************************
}

constructor TSingleCluster.Init(var Bounds: TRect; Text: string;
      ASelNum: Byte; AFlags: Word;
      AStates: pointer; AGroup: Boolean);
Begin
  inherited Init(Bounds, nil, ASelNum, AFlags, AStates);
  Strings.Done;
  Strings.Init(1, 1);
  Strings.AtInsert(0, NewStr(Text));
  Group := AGroup
End;

constructor TSingleCluster.Load(var S: TStream);
Begin
  inherited Load(S);
  S.Read(Group, SizeOf(Group))
End;

function TSingleCluster.DataSize: Sw_Word;
Begin
  If Group then DataSize := SizeOf(Word) else DataSize := 0
End;

procedure TSingleCluster.GetData(var Rec);
var
  P: PSingleCluster;
Begin
  If Group then Begin
    Word(Rec) := 0;
    P := @Self;
    repeat
      P := P^.NextBtn;
      Word(Rec) := Word(Rec) shl Hi(Flags) or P^.Value;
    until P = @Self
  End
End;

procedure TSingleCluster.GetItemRect(Item: Integer; var Extent: TRect);
begin
  SetTextParams(GetStandardFont, 0, 0, false);
  GetExtent(Extent);
  Extent.Grow(-1, - (Extent.B.Y - TextHeight('')) div 2);
end;

procedure TSingleCluster.Go;
Begin
  Select
End;

procedure TSingleCluster.HandleEvent(var Event: TEvent);
Begin
  If (GOwner^.Phase = phFocused) and (Event.What = evKeyDown) then Begin
    case Event.KeyCode of
      kbUp, kbLeft:
	Begin
	  NextBtn^.Go;
	  ClearEvent(Event)
	End;
      kbDown, kbRight:
	Begin
	  PrevBtn^.Go;
	  ClearEvent(Event)
	End;
    End
  End;
  inherited HandleEvent(Event)
End;

function TSingleCluster.NextBtn: PSingleCluster;
var
  P, Q: PGView;
Begin
  P := @Self;
  If Group then Begin			{ find last member of the group }
    repeat
      If TypeOf(P^) = TypeOf(Self) then Q := P;
      P := P^.Prev
    until (TypeOf(P^) = TypeOf(Self)) and PSingleCluster(P)^.Group;
    NextBtn := PSingleCluster(Q)
  End else Begin
    repeat
      P := P^.GNext
    until TypeOf(P^) = TypeOf(Self);
    NextBtn := PSingleCluster(P)
  End
End;

function TSingleCluster.PrevBtn: PSingleCluster;
var
  P: PGView;
Begin
  P := @Self;
  repeat
    P := P^.Prev
  until TypeOf(P^) = TypeOf(Self);
  If PSingleCluster(P)^.Group then Begin	{ find server of the group }
    P := @Self;
    while not ((TypeOf(P^) = TypeOf(Self)) and PSingleCluster(P)^.Group) do
      P := P^.GNext;
  End;
  PrevBtn := PSingleCluster(P)
End;

procedure TSingleCluster.SetData(var Rec);
var
  P: PSingleCluster;
  i: Word;
Begin
  If Group then Begin
    i := Word(Rec);
    P := @Self;
    repeat
      If P^.Value <> i and Lo(Flags) then Begin
	P^.Value := i and Lo(Flags);
	P^.DrawView
      End;
      i := i shr Hi(Flags);
      P := P^.PrevBtn
    until P = @Self
  End
End;

procedure TSingleCluster.Store(var S: TStream);
Begin
  inherited Store(S);
  S.Write(Group, SizeOf(Group))
End;

{ TRadioButton object *******************************************************
}

constructor TRadioButton.Init(var Bounds: TRect; Text: string; AGroup: Boolean);
Begin
  inherited Init(Bounds, Text, 0, cfOneBit, nil, AGroup);
  Value := Byte(AGroup)
End;

procedure TRadioButton.DrawItem(Item: Integer; Down: Boolean);
begin
  TCluster.DrawItem(Item, Down)
end;

procedure TRadioButton.GetData(var Rec);
var
  P: PSingleCluster;
  i: Word;
Begin
  If Group then Begin
    Word(Rec) := 0;
    i := 0;
    P := @Self;
    while (P <> nil) and (P^.Value = 0) do Begin
      P := P^.PrevBtn;
      Inc(i);
      If P = @Self then Exit
    End;
    Word(Rec) := i
  End
End;

function TRadioButton.GetIconNum(Id: Byte): Integer;
const
  Nums: array[1..4] of Byte = (2, 3, 19, 20);
Begin
  GetIconNum := Nums[Id]
End;

procedure TRadioButton.Go;
Begin
  inherited Go;
  TRadioButton.Press(0)
End;

function TRadioButton.Mark(Item: Integer): Boolean;
begin
  Mark := (Item = 0) and (Value = 1)
end;

procedure TRadioButton.Press(Item: Integer);
var
  P: PSingleCluster;
  n: Byte;
Begin
  P := @Self;
  repeat
    P := P^.NextBtn;
    n := Byte(P = @Self);
    with P^ do
    If Value <> n then Begin
      Value := n;
      P^.DrawView
    End
  until P = @Self;
End;

procedure TRadioButton.SetData(var Rec);
var
  i: Word;
  P: PSingleCluster;
  Foc: Boolean;
Begin
  If Group then Begin
    P := @Self;
    Foc := false;
    For i := 1 to Word(Rec) do
    begin
      Foc := Foc or (PGView(P) = GOwner^.Current);
      P := P^.PrevBtn
    end;
    P^.Press(0);
    If Foc then P^.Select;
  End
End;

{ TCheckBox object **********************************************************
}

{ BoxIcons for GvWinDlg.
  Because of Windows far-proc entry code, here is a near copy provided.
  Because of overlayed builds, in ExtGraph is a static copy provided.
}
{$ifdef Windows}
procedure BoxIcons; near; assembler;
Asm
	DW	1
	DW      0000000000000000B
	DW	12
	DW	0000000000000000B
	DW	0100000000010000B
	DW	0010000000100000B
	DW	0001000001000000B
	DW	0000100010000000B
	DW	0000010100000000B
	DW	0000001000000000B
	DW	0000010100000000B
	DW	0000100010000000B
	DW	0001000001000000B
	DW	0010000000100000B
	DW	0100000000010000B
	DW	12
	DW	0000000000000000B
	DW	0010101010100000B
	DW	0101010101010000B
	DW	0010101010100000B
	DW	0101010101010000B
	DW	0010101010100000B
	DW	0101010101010000B
	DW	0010101010100000B
	DW	0101010101010000B
	DW	0010101010100000B
	DW	0101010101010000B
	DW	0010101010100000B
End;
{$endif Windows}

constructor TCheckBox.Init(var Bounds: TRect; Text: string; AGroup: Boolean);
begin
  inherited Init(Bounds, Text, 2, cfOneBit, @BoxIcons, AGroup);
end;

{ T3StateBox object 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

constructor T3StateBox.Init(var Bounds: TRect; Text: string; AGroup: Boolean);
begin
  inherited Init(Bounds, Text, 3, cfTwoBits, @BoxIcons, AGroup);
end;

function T3StateBox.DataSize: Sw_Word;
begin
  If Group
  then DataSize := SizeOf(LongInt)
  else DataSize := 0
end;

{ TRectangle object 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

constructor TRectangle.Init(var Bounds: TRect; AColor: Word; Filled: Boolean);
begin
  inherited Init(Bounds);
  Color := AColor;
  IsFilled := Filled;
  If not Filled then State := State or sfTransparent;
end;

constructor TRectangle.Load(var S: TStream);
begin
  inherited Load(S);
  S.Read(Color, SizeOf(Color));
  S.Read(IsFilled, SizeOf(IsFilled))
end;

procedure TRectangle.Draw;
begin
  If IsFilled
  then begin
    SetFillStyle(SolidFill, Color);
    Bar(0, 0, Size.x - 1, Size.y - 1)
  end
  else begin
    If not GetState(sfTransparent)
    then begin
      SetFillStyle(SolidFill, GetColor(1));
      Bar(1, 1, Size.x - 2, Size.y - 2);
    end;
    SetColor(Color);
    Rectangle(0, 0, Size.x - 1, Size.y - 1)
  end
end;

procedure TRectangle.Store(var S: TStream);
begin
  inherited Store(S);
  S.Write(Color, SizeOf(Color));
  S.Write(IsFilled, SizeOf(IsFilled))
end;

{ TWinLabel object 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

function TWinLabel.GetPalette: PPalette;
const
  P: string[Length(CWinLabel)] = CWinLabel;
begin
  GetPalette := @P
end;

{ TLevel object implementation
}

constructor TLevel.Init(var Bounds: TRect; AHeight: Integer);
begin
  inherited Init(Bounds);
  Height := AHeight;
end;

constructor TLevel.Load(var S: TStream);
begin
  inherited Load(S);
  S.Read(Height, SizeOf(Height))
end;

procedure TLevel.Draw;
var
  R: TRect;
  i: Integer;
  Color: Word;
  P: TPoint;
begin
  inherited Draw;
  Color := GetColor(1);
  If Height = 0
  then begin
    {LongInt(P) := $10000;}
    P.X := 0; P.Y := 1;
    SetColor(EdgeColor(P, Color));
    Rectangle(1, 1, Size.X - 1, Size.Y - 1);
    {LongInt(P) := 1;}
    P.X := 1; P.Y := 0;
    SetColor(EdgeColor(P, Color));
    Rectangle(0, 0, Size.X - 2, Size.Y - 2)
  end
  else begin
    GetExtent(R);
    Dec(R.B.X);
    Dec(R.B.Y);
    For i := 1 to abs(Height) do
    begin
      EdgeRect(R.A, R.B, Height < 0, Color);
      R.Grow(-1, -1)
    end
  end
end;

procedure TLevel.Store(var S: TStream);
begin
  inherited Store(S);
  S.Write(Height, SizeOf(Height))
end;

{ TPassInputLine object 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

procedure TPassInputLine.DrawText(APos, EPos: Integer);
var
  Save: string;
begin
  Save := Data^;
  FillChar(Data^[1], Length(Data^), '*');
  inherited DrawText(APos, EPos);
  Data^ := Save
end;

{ TWinDialog object ********************************************************
}

constructor TWinDialog.Init(var Bounds: TRect; ATitle: TTitleStr; Gray: Boolean);
begin
  inherited Init(Bounds, ATitle);
  GrayBack := Gray;
end;

constructor TWinDialog.RawInit;
var
  R: TRect;
begin
  R.Assign(0, 0, 100, 100); { Dummy bounds }
  inherited Init(R, '')
end;

constructor TWinDialog.Load(var S: TStream);
begin
  inherited Load(S);
  S.Read(GrayBack, SizeOf(GrayBack))
end;

function TWinDialog.GetControl(id: Integer): PGView;

	function HasThisCtx(P: PGView): Boolean; {$ifndef FPK}far;{$endif}
	begin
	  HasThisCtx := P^.HelpCtx = id
	end;

begin
  GetControl := FirstThat(@HasThisCtx)
end;

{function TWinDialog.GetHelpCtx: Word;
begin
  If Current <> nil
  then GetHelpCtx := HelpCtx + Current^.GetHelpCtx
  else GetHelpCtx := HelpCtx
end;}

function TWinDialog.GetPalette: PPalette;
const
  P: string[Length(CGrayDialog)] = CGrayDialog;
begin
  If GrayBack
  then GetPalette := @P
  else GetPalette := inherited GetPalette
end;

procedure TWinDialog.Store(var S: TStream);
begin
  inherited Store(S);
  S.Write(GrayBack, SizeOf(GrayBack))
end;

{ Support routines **********************************************************
}

procedure SetupInfo(Data: PDialogBoxHeader; Info: PDialogInfo);
var
  Metrics: TTextMetric;
Begin
  with Info^ do Begin
    If (Data^.szFaceName <> nil) and
       (StrIComp(Data^.szFaceName, 'Helv') = 0)
      then Font := ftSansSerif
      else Font := ftSystem;
    SetTextParams(Font, 0, 15, true);
    GetTextMetrics(Metrics);
    Base.x := (Metrics.tmAveCharWidth+1) / 4.0;
    Base.y := Metrics.tmHeight / 8.0;
    Move.x := 6; Move.y := 26;
    Grow.x := 12; Grow.y := 32;
    Group := false;
    Links := nil;
    Wake := @WakeDialog
  End
End;

function XlatCmd(id: Word): Word;
const
  Tbl: array[0..7] of Word
  = (0, cmOK, cmCancel, cmCancel, cmYes, cmNo, cmYes, cmNo);
Begin
  If id <= id_No
    then XlatCmd := Tbl[id]
    else XlatCmd := id
End;

procedure GetDialogRect(var Bounds: TRect;
  Data: PDialogBoxHeader; Info: PDialogInfo);
Begin
  with Data^, Info^ do Begin
    Bounds.Assign(0, 0, Round(cx * Base.x) + Grow.x, Round(cy * Base.y) + Grow.y);
    Bounds.Move(Round(x * Base.x), Round(y * Base.y))
  End
End;

procedure GetControlRect(var Bounds: TRect;
  Data: PControlData; Info: PDialogInfo);
Begin
  with Data^, Info^ do Begin
    Bounds.Assign(0, 0, Round(cx * Base.x), Round(cy * Base.y));
    Bounds.Move(Round(x * Base.x) + Move.x, Round(y * Base.y) + Move.y);
  End
End;

function InsertControl(Dialog: PDialog; View: PGView): PGView;
begin
  Dialog^.Insert{Before}(View{, Dialog^.Frame});
  InsertControl := View
end;

function NilStrPas(s: PChar): string;
begin
  If Seg(s^) = 0
  then NilStrPas := ''
  else NilStrPas := StrPas(s)
end;

var
  CurrentPos: LongInt;

function AccessResource(Info: PDialogInfo): PStream;
begin
  with Info^ do
  begin
    AccessResource := Resource;
    CurrentPos := Resource^.GetPos;
    Resource^.Seek(ResTblPos)
  end
end;

procedure UnaccessResource(Info: PDialogInfo);
begin
  with Info^ do
    Resource^.Seek(CurrentPos)
end;

{ Init dialog routine *******************************************************
}

procedure InitWinDialog(Data: PDialogBoxHeader; Info: PDialogInfo; Gray: Boolean);
var
  R: TRect;
begin
  SetUpInfo(Data, Info);
  GetDialogRect(R, Data, Info);
  with Data^, Info^ do
  begin
    Dialog := DialogTemplate;
    with PWinDialog(Dialog)^ do
    begin
      Locate(R);
      DisposeStr(Title);
      Title := NewStr(NilStrPas(szCaption));
      GrayBack := Gray;
      StandardFont := Font
    end;
    DialogTemplate := nil
  end
end;

procedure InitDialog(Data: PDialogBoxHeader; Info: PDialogInfo);
Begin
  If DialogTemplate = nil
  then DialogTemplate := New(PWinDialog, RawInit);
  InitWinDialog(Data, Info, false)
End;

procedure InitBorDlg(Data: PDialogBoxHeader; Info: PDialogInfo);
Begin
  If DialogTemplate = nil
  then DialogTemplate := New(PWinDialog, RawInit);
  InitWinDialog(Data, Info, true)
End;

{ Init control routines *****************************************************
}

procedure InitButton(Data: PControlData; Info: PDialogInfo);
var
  P: PGView;
  R, RR: TRect;
  Buf: array[0..255] of Char;
  s: string;
  h: Integer;
  Ctx: Word;

  function bf_LeftJust: Word;
  Begin
    If Data^.lStyle and bs_LeftText <> 0
    then bf_LeftJust := bfLeftJust
    else bf_LeftJust := 0
  End;

Begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do Begin
    Group := Group or (lStyle and ws_Group <> 0);
    If Seg(szText^) = 0 then Buf[0] := #0 else StrLCopy(Buf, szText, 256);
    ConvertMarkers(Buf, 256);
    Ctx := wID;
    case lStyle and $1F of
      bs_PushButton:
        begin
	  P := New(PButton, Init(R, StrPas(Buf), XlatCmd(wID), bfNormal + bf_LeftJust));
          Ctx := HelpCtxDelta + XlatCmd(wID)
        end;
      bs_DefPushButton:
        begin
	  P := New(PButton, Init(R, StrPas(Buf), XlatCmd(wID), bfDefault + bf_LeftJust));
          Ctx := HelpCtxDelta + XlatCmd(wID)
        end;
      bs_3State,
      bs_Auto3State:
	P := New(P3StateBox, Init(R, StrPas(Buf), Group));
      bs_CheckBox,
      bs_AutoCheckBox:
	P := New(PCheckBox, Init(R, StrPas(Buf), Group));
      bs_RadioButton,
      bs_AutoRadioButton:
	P := New(PRadioButton, Init(R, StrPas(Buf), Group));
      bs_GroupBox:
	begin
	  { Create a rectangle and a static text for upper left corner
	  }
	  SetTextParams(PDialog(Dialog)^.GetStandardFont, 0, 0, true);
	  s := ' ' + StrPas(Buf) + ' ';
	  h := TextHeight('') + 2;
	  RR := R;
	  Inc(R.A.X, TextWidth('  '));
	  R.B.X := R.A.X + TextWidth(s);
	  R.B.Y := R.A.Y + h;
	  Inc(RR.A.Y, h div 2);

	  P := New(PRectangle, Init(RR, Black, false));
	  InsertControl(Dialog, P);

	  P := New(PStaticText, Init(R, s));
	end;
      else Begin
	P := New(PButton, Init(R, StrPas(Buf), 101, bfNormal));
	P^.SetState(sfDisabled, true)
      End
    end;
    Group := false;
    P^.HelpCtx := Ctx;
    CreateLinks(Info, P);
    InsertControl(Dialog, P);
  End
End;

procedure InitStatic(Data: PControlData; Info: PDialogInfo);
var
  P: PGView;
  R: TRect;
  Buf: array[0..255] of Char;
  Markers: Boolean;

 function _Center: string;
 Begin
   If Data^.lStyle and $7F = ss_Center
   then _Center := ^C
   else _Center := ''
 End;

Begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do Begin
    Group := Group or (lStyle and ws_Group <> 0);
    If Seg(szText^) = 0 then Buf[0] := #0 else StrLCopy(Buf, szText, 256);
    Markers := (lStyle and ss_NoPrefix = 0) and ConvertMarkers(Buf, 256);
    case lStyle and $7F of
      ss_Left,
      ss_Center,
      ss_Right,
      ss_LeftNoWordWrap,
      ss_Simple:
	If Markers
	then Begin
	  P := New(PWinLabel, Init(R, _Center + StrPas(Buf), nil));
	  InsertLink(Info, @LinkLabel, P)
	End
	else P := New(PStaticText, Init(R, _Center + StrPas(Buf)));
      ss_BlackRect:
	P := New(PRectangle, Init(R, 0, true));
      ss_GrayRect:
	P := New(PRectangle, Init(R, 7, true));
      ss_WhiteRect:
	P := New(PRectangle, Init(R, 15, true));
      ss_BlackFrame:
	P := New(PRectangle, Init(R, 0, false));
      ss_GrayFrame:
	P := New(PRectangle, Init(R, 7, false));
      ss_WhiteFrame:
	P := New(PRectangle, Init(R, 15, false));
      ss_Icon:
	begin
	  P := New(PIconLabel, Init(R, AccessResource(Info), szText, nil));
	  UnaccessResource(Info);
	  InsertLink(Info, @LinkLabel, P)
	end;
      else P := New(PStaticText, Init(R, StrPas(Buf)));
    end;
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
  End;
End;

function GetLengthValue(szText: PChar): Integer;
var
  i: Integer;
  E: Word;
  C: Char;
  P: PChar;
Begin
  GetLengthValue := 255;
  If szText <> nil then
    If szText[0] = '@' then Begin
      Val(szText+1, i, E);
      If E = 0 then GetLengthValue := i else
      if E > 1
      then begin
	P := szText + E;
	C := P[0];
	P[0] := #0;
	Val(szText+1, i, E);
	P[0] := C;
	If E = 0 then GetLengthValue := i
      end
    End
End;

procedure InitEdit(Data: PControlData; Info: PDialogInfo);
var
  P: PInputLine;
  R: TRect;
  i: Integer;
Begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do Begin
    i := GetLengthValue(szText);
    If lStyle and es_Password = 0
    then P := New(PInputLine, Init(R, i))
    else P := New(PPassInputLine, Init(R, i));
    P^.SetValidator(CreateValidator(szText));
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
    Group := false;
    CreateLinks(Info, P)
  End
End;

procedure SplitRectSB(var Bounds: TRect; var HorizRect, VertRect: TRect;
  Horiz, Vert: Boolean);
Begin
  with Bounds do Begin
    If Horiz then Dec(B.y, 17);
    If Vert then Begin
      Dec(B.x, 17);
      VertRect.Assign(B.x - 1, A.y, B.x + 17, B.y);
    End;
    If Horiz then
      HorizRect.Assign(A.x, B.y - 1, B.x, B.y + 17)
  End
End;

procedure InitListBox(Data: PControlData; Info: PDialogInfo);
var
  P: PGView;
  R, SBR: TRect;
Begin
  GetControlRect(R, Data, Info);
  SplitRectSB(R, R, SBR, false, true);
  with Data^, Info^ do Begin
    P := New(PScrollBar, Init(SBR));
    InsertControl(Dialog, P);
    P := New(PListBox, Init(R, PScrollBar(P)));
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
    Group := false;
    CreateLinks(Info, P)
  End
End;

procedure SplitRectCB(var Bounds: TRect; var Arrow: TRect);
Begin
  Bounds.B.Y := Bounds.A.Y + 20;
  Arrow := Bounds;
  Dec(Bounds.B.X, 17);
  Arrow.A.X := Bounds.B.x - 1
End;

procedure InitCombobox(Data: PControlData; Info: PDialogInfo);
var
  R, A: TRect;
  P: PInputLine;
  H: PGView;
  i: Integer;
Begin
  GetControlRect(R, Data, Info);
  SplitRectCB(R, A);
  with Data^, Info^ do Begin
    i := GetLengthValue(szText);
    P := New(PInputLine, Init(R, i));
    P^.SetValidator(CreateValidator(szText));
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
    H := New(PHistory, Init(A, P, wID));
    InsertControl(Dialog, H);
    Group := false;
    CreateLinks(Info, P)
  End;
End;

procedure InitScrollbar(Data: PControlData; Info: PDialogInfo);
var
  R: TRect;
  P: PGView;
begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do Begin
    Group := Group or (lStyle and ws_Group <> 0);
    If lStyle and sbs_Vert <> 0
    then R.B.X := R.A.X + 18
    else R.B.Y := R.A.Y + 18;
    P := New(PScrollbar, Init(R));
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
  end;
end;

{ BWCC support 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

procedure InitBorBtn(Data: PControlData; Info: PDialogInfo);
var
  Flags: Word;
  R: TRect;
  P: PGView;
  Buf: array[0..255] of Char;
  Ctx: Word;
begin
  If BWCC = nil
  then InitButton(Data, Info)
  else begin
    GetControlRect(R, Data, Info);
    with Data^, Info^ do Begin
      Group := Group or (lStyle and ws_Group <> 0);
      If Seg(szText^) = 0 then Buf[0] := #0 else StrLCopy(Buf, szText, 256);
      ConvertMarkers(Buf, 256);
      case lStyle and $1F of
	bs_PushButton:
	  Flags := bfNormal;
	bs_DefPushButton:
	  Flags := bfDefault;
	else
	  Flags := 0;
      end;
      If lStyle and bbs_OwnerDraw = 0
      then begin
	R.B.X := R.A.X + BWCCButtonSize.x + 2;
	R.B.Y := R.A.Y + BWCCButtonSize.y + 2;
	Ctx := XlatCmd(wId) + HelpCtxDelta
      end
      else
	Ctx := wID;
      P := New(PImageButton, InitByBWCC(R,
	StrPas(Buf), BWCC, wID, XlatCmd(wID), Flags));
      Group := false;
      P^.HelpCtx := Ctx;
      CreateLinks(Info, P);
      InsertControl(Dialog, P);
    End
  end
end;

procedure InitBorShade(Data: PControlData; Info: PDialogInfo);
var
  R, LabelR: TRect;
  P: PGView;
  Buf: array[0..255] of Char;
begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do Begin
    Group := Group or (lStyle and ws_Group <> 0);
    case lStyle and $7F of
      1, 6:
	begin
	  If Seg(szText^) <> 0
	  then begin
	    SetTextParams(PDialog(Dialog)^.GetStandardFont, 0, 0, true);
	    LabelR := R;
	    LabelR.B.Y := LabelR.A.Y + TextHeight('');
	    R.A.Y := LabelR.B.Y
	  end;
	  P := New(PLevel, Init(R, Byte(lStyle and $7F = 6) * 2 - 1));
	  If Seg(szText^) <> 0
	  then begin
	    InsertControl(Dialog, P);
	    StrLCopy(Buf, szText, 256);
	    ConvertMarkers(Buf, 256);
	    If lStyle and $100 <> 0
	    then P := New(PWinLabel, Init(LabelR, ^c + StrPas(Buf), nil))
	    else P := New(PWinLabel, Init(LabelR, StrPas(Buf), nil));
	    InsertLink(Info, @LinkLabel, P)
	  end
	end;
      2, 4:
	begin
	  R.B.Y := R.A.Y + 2;
	  P := New(PLevel, Init(R, lStyle and $7F - 3))
	end;
      3, 5:
	begin
	  R.B.X := R.A.X + 2;
	  P := New(PLevel, Init(R, lStyle and $7F - 4))
	end;
    end;
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
  end;
end;

procedure InitLevelZero(Data: PControlData; Info: PDialogInfo);
var
  R: TRect;
  P: PGView;
begin
  GetControlRect(R, Data, Info);
  with Data^, Info^ do
  begin
    Group := Group or (lStyle and ws_Group <> 0);
    P := New(PLevel, Init(R, 0));
    P^.HelpCtx := wId;
    InsertControl(Dialog, P);
  end;
end;

{ Link routines *************************************************************
}

procedure LinkLabel(Link: PGView; Control: PLabel);
Begin
  Control^.Link := Link;
End;

procedure LinkIcon(Link: PGView; Control: PIcon);
Begin
  Control^.Link := Link
End;

{ Wake dialog routine *******************************************************
}

procedure WakeDialog(Info: PDialogInfo);
Begin
  PDialog(Info^.Dialog)^.SelectNext(false)
End;

{ Validator routines ********************************************************
}

function CreateValidator(Title: PChar): PValidator;
type
  TValidatorProcX = function(var Args; High: Integer): PValidator;
var
  Cls, P: PChar;
  Args: array[0..15] of PChar;
  VClass: PClassRec;
  Count: Integer;

	function SkipWhite(P: PChar): PChar;
	begin
	  while (P[0] <> #0) and (P[0] <= ' ') do Inc(P);
	  SkipWhite := P
	end;

begin
  CreateValidator := nil;
  If Title = nil then Exit;
  while (Title[0] in ['@', '0'..'9']) do Inc(Title);
  Title := SkipWhite(Title);
  Cls := Title;
  while (Title[0] in ['A'..'Z', '_', 'a'..'z', '0'..'9']) do Inc(Title);
  P := SkipWhite(Title);
  If (P = Title) and (P[0] <> #0) then Inc(P);
  Title[0] := #0;
  For Count := 0 to 15 do
    Args[Count] := Title;
  Count := 0;
  while (Count <= 15) and (P <> nil) and (P[0] <> #0) do
  begin
    while (P[0] in [#1..' ', '(', ')', ',', ';']) do Inc(P);
    If P[0] <> #0 then
    If P[0] in ['''', '"']
    then begin
      Args[Count] := P + 1;
      Inc(Count);
      P := StrScan(P + 1, P[0]);
      If P <> nil
      then begin
	P[0] := #0;
	Inc(P)
      end
    end
    else begin
      Args[Count] := P;
      Inc(Count);
      while not (P[0] in [#0..' ', ',', ';', '(', ')']) do Inc(P);
      If P[0] <> #0
      then begin
	P[0] := #0;
	Inc(P)
      end
    end;
  end;
  VClass := GetClass(Cls, ctValidator);
  If VClass = nil
  then CreateValidator := nil
  else begin
    If Count > 0 then Dec(Count);
    CreateValidator := TValidatorProcX(VClass^.Init)(Args, Count)
  end
end;

function InitFilterValidator(const Args: array of PChar): PValidator;
var
  S: TCharSet;
  P: PChar;
begin
  S := [];
  P := Args[0];
  while P[0] <> #0 do
  begin
    Include(S, P[0]);
    Inc(P)
  end;
  InitFilterValidator := New(PFilterValidator, Init(S));
end;

function InitRangeValidator(const Args: array of PChar): PValidator;
var
  min, max: LongInt;
  E: Word;
  V: PValidator;
begin
  Val(Args[0], min, E);
  Val(Args[1], max, E);
  V := New(PRangeValidator, Init(min, max));
  V^.Options := V^.Options or voTransfer;
  InitRangeValidator := V
end;

function InitPictureValidator(const Args: array of PChar): PValidator;
begin
  InitPictureValidator := New(PPXPictureValidator,
    Init(StrPas(Args[0]), High(Args) > 0));
end;

function InitRealValidator(const Args: array of PChar): PValidator;
var
  V: PValidator;
  Dec: Integer;
  E: Word;
begin
  Val(Args[0], Dec, E);
  V := New(PRealValidator, Init(Dec));
  V^.Options := V^.Options or voTransfer;
  InitRealValidator := V
end;

{ Register classes routine **************************************************
}

procedure RegisterGvWinDlg;
Begin
  RegisterClass(classDialog);
{$ifndef FPK}
  RegisterClass(classButton);
  RegisterClass(classStatic);
  RegisterClass(classEdit);
  RegisterClass(classListbox);
  RegisterClass(classComboBox);
  RegisterClass(classScrollbar);
{$endif}
  RegisterClass(classBorDlg);
  RegisterClass(classBorCheck);
  RegisterClass(classBorRadio);
  RegisterClass(classBorShade);
  RegisterClass(classBorBtn);
  RegisterClass(classBorStatic);
  RegisterClass(classGvLevelZero);
  RegisterClass(classFilterValidator);
  RegisterClass(classPictureValidator);
  RegisterClass(classRealValidator);
  RegisterClass(classRangeValidator);
  RegisterType(RCheckBox);
  RegisterType(RRadioButton);
  RegisterType(R3StateBox);
  RegisterType(RRectangle);
  RegisterType(RWinLabel);
  RegisterType(RLevel);
  RegisterType(RWinDialog);
  RegisterType(RPassInputLine);
End;

end.
