Category : Pascal Source Code
Archive   : SHAZAM2.ZIP
Filename : GDIALOG.IMP

 
Output of file : GDIALOG.IMP contained in archive : SHAZAM2.ZIP
{*******************************************************************

GDIALOG.IMP

*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

DIALOG UTILITIES

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

COPY DIALOG - Otherwise known as "reverse polymorphism"

===================================================================}
function CopyDialog ( DSource , DTarget : PDialog ) : boolean ;
{-------------------------------------------------------------------
ACTION
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
P^.Owner := DTarget ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
var
R : TRect ;
begin
CopyDialog := FALSE ; { set flag }
if DSource = NIL then EXIT ; { nothing to do }
if DTarget = NIL then EXIT ; { nothing to do }
DSource^.GetBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
TARGET - change elements, then switch ownership.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DTarget^ do
begin
Dispose ( Frame , Done ) ; { free }
if Title <> NIL then
DisposeStr ( Title ) ; { free }
ChangeBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
COMPONENTS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
Frame := DSource^.Frame ; { screen }
Title := DSource^.Title ; { screen }
Buffer := DSource^.Buffer ; { screen }
Next := DSource^.Next ; { sub-view }
Last := DSource^.Last ; { sub-view }
Current := DSource^.Current ; { sub-view }
Owner := DSource^.Owner ; { parent }
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SOURCE - make sure we don't dispose stuff we need!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DSource^ do
begin
Frame := NIL ; { screen }
Title := NIL ; { screen }
Buffer := NIL ; { screen }
Next := NIL ; { sub-view }
Last := NIL ; { sub-view }
Current := NIL ; { sub-view }
Owner := NIL ; { parent }
end ;
Dispose ( DSource , Done ) ; { dump original }

DTarget^.ForEach ( @Action ) ; { fields }

CopyDialog := TRUE ; { set flag }
end ;
{===================================================================

SCROLLBAR - Vertical, either side

===================================================================}
function AddVScrollBar ( G : PGroup ; Right : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Right then
begin
R.A := R.B ;
dec ( R.A.X ) ; { go left, to be visible }
dec ( R.B.Y ) ; { don't cover corner }
R.A.Y := 1 ; { don't cover corner }
end
else
begin
R.B.X := R.A.X + 1 ; { go right, to be visible }
R.A.Y := 1 ; { don't cover corner }
dec ( R.B.Y ) ; { don't cover corner }
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddVScrollBar := SB ;
end ;
{===================================================================

SCROLLBAR - Horizontal, top or bottom

===================================================================}
function AddHScrollBar ( G : PGroup ; Bottom : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Bottom then
begin
R.A.Y := R.B.Y - 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ; { don't cover corner }
end
else
begin
R.B.Y := R.A.Y + 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ;
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddHScrollBar := SB ;
end ;
{===================================================================

COUNT - Views which can hold data (non-static).

===================================================================}
function TActiveCount ( D : PDialog ) : byte ;
var
x : byte ;

procedure DoThis ( P : PView ) ; FAR ;
begin
if P^.DataSize = 0 then EXIT ;
inc ( x ) ;
end ;

begin
x := 0 ;
D^.ForEach ( @DoThis ) ;
TActiveCount := x ;
end ;
{===================================================================

Return pointer to view with data.

===================================================================}
function DataRecPtr ( D : PDialog ; Fnum : byte ) : pointer ;
var
x : byte ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
function DoThis ( P : PView ) : boolean ; FAR ;
var
S : string ;
begin
DoThis := FALSE ;
if P^.DataSize = 0 then EXIT ;
dec ( x ) ;
if x <> Fnum then EXIT ;
DoThis := TRUE ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
DataRecPtr := NIL ;
x := TActiveCount ( D ) + 1 ;
if FNum > x then EXIT ;
DataRecPtr := D^.FirstThat ( @DoThis ) ;
end ;
{===================================================================

SET - Reference View's data by view order number.

===================================================================}
procedure SetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.SetData ( Data^ ) ;
P^.DrawView ;
end ;
{===================================================================

GET - Reference View's data by view order number.

===================================================================}
procedure GetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.GetData ( Data^ ) ;
end ;
{===================================================================

BUTTON ON/OFF

===================================================================}
procedure SetButtons ( D : PDialog ; On : boolean ) ;

procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TButton ) then EXIT ;
if On then
P^.Show
else
P^.Hide ;
end ;

var
Temp : PView ;
begin
Temp := D^.Current ;
D^.ForEach ( @DoThis ) ;
Temp^.Select ;
end ;
{===================================================================

STATIC TEXT ON/OFF

===================================================================}
procedure SetStaticText ( D : PDialog ; On : boolean ) ;

procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TStaticText ) then EXIT ;
if On then
P^.Show
else
P^.Hide ;
end ;

var
Temp : PView ;
begin
Temp := D^.Current ;
D^.ForEach ( @DoThis ) ;
Temp^.Select ;
end ;
{===================================================================

Use DESKTOP to ExecView dialog. Turns on "ofCentered" for
PDialog^.Options, to compensate for VGA/EGA modes (so it doesn't
matter what VideoMode we're in).

Returns cmXXXX & data pointer; if there is not enough memory or
the dialog is missing from a resource file, user is notified of
the error via a message box.

===================================================================}
function ExecDialog ( P : PDialog ; Data : pointer ) : word ;
var
Result : word ;
begin
ExecDialog := cmCancel ;
if P = NIL then
begin
MessageBox ( ^C'Dialog is missing!' ,
NIL ,
mfError + mfCancelButton ) ;
EXIT ;
end ;
P := PDIALOG ( Application^.ValidView ( P ) ) ;
if P = NIL then EXIT ;
if Data <> NIL then
P^.SetData ( Data^ ) ;
P^.Options := P^.Options OR ofCentered ; { EGA/VGA }
Result := Desktop^.ExecView ( P ) ;
if Result <> cmCancel then
if Data <> NIL then
P^.GetData ( Data^ ) ;
Dispose ( P , Done ) ;
ExecDialog := Result ;
end ;
{===================================================================

PALETTE - can be customized for program, but this works for most.

===================================================================}
function SetColorsDialog : PDialog ;
begin
SetColorsDialog := New ( PColorDialog ,
Init ( '' ,
ColorGroup ( 'Ascii table' ,
ColorItem ( 'Frame passive' , 24 ,
ColorItem ( 'Frame active' , 25 ,
ColorItem ( 'Frame icons' , 26 ,
ColorItem ( 'Scroll bar page' , 27 ,
ColorItem ( 'Scroll bar icons' , 28 ,
ColorItem ( 'Text' , 29 ,
NIL)))))) ,
ColorGroup ( 'Desktop' ,
ColorItem ( 'Color' , 32 ,
NIL) ,
ColorGroup ( 'Dialogs' ,
ColorItem ( 'Frame/background' , 33 ,
ColorItem ( 'Frame icons' , 34 ,
ColorItem ( 'Scroll bar page' , 35 ,
ColorItem ( 'Scroll bar icons' , 36 ,
ColorItem ( 'Static text' , 37 ,


ColorItem ( 'Label normal' , 38 ,
ColorItem ( 'Label selected' , 39 ,
ColorItem ( 'Label shortcut' , 40 ,

ColorItem ( 'Button normal' , 41 ,
ColorItem ( 'Button default' , 42 ,
ColorItem ( 'Button selected' , 43 ,
ColorItem ( 'Button disabled' , 44 ,
ColorItem ( 'Button shortcut' , 45 ,
ColorItem ( 'Button shadow' , 46 ,

ColorItem ( 'Cluster normal' , 47 ,
ColorItem ( 'Cluster selected' , 48 ,
ColorItem ( 'Cluster shortcut' , 49 ,

ColorItem ( 'Input normal' , 50 ,
ColorItem ( 'Input selected' , 51 ,
ColorItem ( 'Input arrow' , 52 ,

ColorItem ( 'History button' , 53 ,
ColorItem ( 'History sides' , 54 ,
ColorItem ( 'History bar page' , 55 ,
ColorItem ( 'History bar icons' , 56 ,

ColorItem ( 'List normal' , 57 ,
ColorItem ( 'List focused' , 58 ,
ColorItem ( 'List selected' , 59 ,
ColorItem ( 'List divider' , 60 ,

ColorItem ( 'Information pane' , 61 ,
NIL))))))))))))))))))))))))))))) ,
ColorGroup ( 'Menus' ,
ColorItem ( 'Normal' , 2 ,
ColorItem ( 'Disabled' , 3 ,
ColorItem ( 'Shortcut' , 4 ,
ColorItem ( 'Selected' , 5 ,
ColorItem ( 'Selected disabled' , 6 ,
ColorItem ( 'Shortcut selected' , 7 ,
NIL)))))) ,
ColorGroup ( 'Text' ,
ColorItem ( 'Frame passive' , 8 ,
ColorItem ( 'Frame active' , 9 ,
ColorItem ( 'Frame icons' , 10 ,
ColorItem ( 'Scroll bar page' , 11 ,
ColorItem ( 'Scroll bar icons' , 12 ,
ColorItem ( 'Text' , 13 ,
NIL)))))) ,
NIL))))))) ;
end ;
{===================================================================

SET - dialog with help context

===================================================================}
procedure SetColors ( HelpCtx : word ) ;
var
D : PDialog ;
OldPalette : TPalette ;
begin
D := SetColorsDialog ;
OldPalette := Application^.GetPalette^ ;
D^.HelpCtx := HelpCtx ;
case ExecDialog ( D , Application^.GetPalette ) of
cmCancel : Application^.GetPalette^ := OldPalette ;
end ;
hdRefreshDisplay ;
end ;


  3 Responses to “Category : Pascal Source Code
Archive   : SHAZAM2.ZIP
Filename : GDIALOG.IMP

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/