CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/Pascal/TVDMX.ZIP/DMXFORMS.PAS

Pascal/Delphi Source File | 1993-04-01 | 10.8 KB | 414 lines

{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
{                            }
{    DMXFORMS  --Form Editing Unit            }
{    tvDMX     --data editing project (ver 2.1)    }
{                            }
{    Copyright (c) 1993  Randolph Beck        }
{                P.O. Box  56-0487        }
{                Orlando, FL 32856        }
{                CIS:  72361,753        }
{                            }
{■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}

Unit DMXFORMS;

{$B-,D+,O+,R-,V-,X+ }

interface

uses Objects, Drivers, Memory, Views, Dialogs, Menus, App,
     RSet, DmxGizma, tvDMX;

const
    CDmxDlgForm        = #26#12#10#10#01#02;
             {  |  |  |  |  |  |  }
  {  1 normal fields -------+  |  |  |  |  |  }
  {  2 normal selected field --+  |  |  |  |  }
  {  3 read-only selected field --+  |  |  |  }
  {  4 locked field -----------------+  |  |  }
  {  5 delimiter -----------------------+  |  }
  {  6 border -----------------------------+  }

type
    PFldPtrArray    = ^TFldPtrArray;
    TFldPtrArray    =  array [0..8195] of pDMXfieldrec;


    PDmxForm        = ^TDmxForm;
    TDmxForm        =  OBJECT (TDmxEditor)
    InScrl        : boolean;
    NumRows        : integer;
    DMXfields    : PFldPtrArray;
      constructor Init (ATemplates : PSItem;  AInScroll : boolean;
            var AData;  var Bounds : TRect;  ALabels,ARecInd : PDmxLink;
            AHScrollBar,AVScrollBar : PScrollBar);
      function  DataAt (RecNum : integer) : pointer;  VIRTUAL;
      procedure DoneStruct;   VIRTUAL;
      procedure Draw;         VIRTUAL;
      procedure HandleEvent (var Event : TEvent);  VIRTUAL;
      procedure InitStruct (var ATemplate );  VIRTUAL;
      procedure LoadStruct (var S : TStream);  VIRTUAL;
      procedure SetupField;   VIRTUAL;
      procedure SetupRecord;  VIRTUAL;
      procedure StoreStruct (var S : TStream);  VIRTUAL;
      private
    FirstDataRow    : integer;
    PrevRec        : integer;
    end;


    PDmxDlgForm        = ^TDmxDlgForm;
    TDmxDlgForm        =  OBJECT (TDmxForm)
      constructor Init (ATemplates : PSItem;
            var Bounds : TRect;
            AHScrollBar,AVScrollBar : PScrollBar);
      function  DataSize : word;  VIRTUAL;
      procedure DoneData;  VIRTUAL;
      procedure GetData (var Rec );  VIRTUAL;
      function  GetPalette : PPalette;  VIRTUAL;
      procedure InitData (var AData );  VIRTUAL;
      procedure SetData (var Rec );  VIRTUAL;
    end;


  procedure RegisterDMXFORMS;


const
    RDmxForm    :  TStreamRec = (
    ObjType:  rnDmxForm;
    VmtLink:  ofs (TypeOf (TDmxForm)^);
    Load:     @TDmxForm.Load;
    Store:    @TDmxForm.Store
      );

    RDmxDlgForm    :  TStreamRec = (
    ObjType:  rnDmxDlgForm;
    VmtLink:  ofs (TypeOf (TDmxDlgForm)^);
    Load:     @TDmxDlgForm.Load;
    Store:    @TDmxDlgForm.Store
      );


implementation

  { ══ TDmxForm ══════════════════════════════════════════════════════════ }


constructor TDmxForm.Init (ATemplates : PSItem;  AInScroll : boolean;
            var AData;  var Bounds : TRect;  ALabels,ARecInd : PDmxLink;
            AHScrollBar,AVScrollBar : PScrollBar);
var  S : string [sizeof (PSItem) + 1];
begin
  Move (ATemplates, S [1], sizeof (PSItem));
  S [0] := #4;
  TDmxEditor.Init (S, AData, 0, Bounds, ALabels, ARecInd, AHScrollBar, AVScrollBar);
  InScrl := AInScroll;
end;


procedure TDmxForm.LoadStruct (var S : TStream);
var  i : integer;
begin
  S.Read (InScrl,  sizeof (InScrl));
  S.Read (NumRows, sizeof (NumRows));
  S.Read (FirstDataRow, sizeof (FirstDataRow));
  If (NumRows > 0) then
    begin
    GetMem (DMXfields, (NumRows * 4) + 200);
    For i := 0 to pred (NumRows) do
      begin
      TDmxEditor.LoadStruct (S);
      DMXfields^ [i] := DMXfield1;
      end;
    end;
  PrevRec := -1;
end;


function  TDmxForm.DataAt (RecNum : integer) : pointer;
begin
  DMXfield1 := DMXfields^ [RecNum];
  DataAt := WorkingData;
end;


procedure TDmxForm.DoneStruct;
var  Items,P : PSItem;
     i,Lim   : integer;
begin
  If (DMXfields = nil) then Exit;
  i := NumRows;
  While (i > 0) do
    begin
    DMXfield1 := DMXfields^ [pred (i)];
    If (DMXfield1 <> nil) then TDmxEditor.DoneStruct;
    Dec (i);
    end;
  FreeMem (DMXfields, (NumRows * 4) + 200);
  NumRows := 0;
  Limit.X := 0;
  DataBlockSize := 0;
  RecordSize := 0;
end;


procedure TDmxForm.Draw;
begin
  TDmxScroller.Draw;
  DMXfield1 := DMXfields^ [CurrentRecord];
  If FieldSelected and (showanyway in ShowFmt) and (CurrentField <> nil) then
    DrawField (CurrentField);
end;


procedure TDmxForm.HandleEvent (var Event : TEvent);
var  i,j    : word;
     RS,FS    : boolean;
     MousePlace    : TPoint;
     PrevFld    : pDMXfieldrec;
begin
  With Event do
    If (Event.What = evMouseDown) and GetState (sfFocused) and
       (MouseInView (Where)) then
      begin
      RS := RecordSelected;
      FS := FieldSelected;
      If FS then EvaluateField;
      If RS then EvaluateRecord;
      MakeLocal (Where, MousePlace);
      MousePlace.X := MousePlace.X + Delta.X;
      MousePlace.Y := MousePlace.Y + Delta.Y;
      i := cmDMX_goto;
      DMXfield1 := DMXfields^ [MousePlace.Y];
      PrevFld    := CurrentField;
      CurrentField := DMXfield1;
      If (MousePlace.Y < Limit.Y) then
    ProcessCommand (i, MousePlace)
       else
    DoubleValid := FALSE;
      If not DoubleValid then
    begin
    WrongKeypressed (Event);
    CurrentField := PrevFld;
    end;
      ClearEvent (Event);
      If RS then SetupRecord;
      If FS then SetupField;
      end
     else
      begin
      Case What of
    evCommand,evBroadcast:
      begin
      If (Command = cmDMX_Draw) or (Command = cmDMX_DrawData) then
        begin
        DrawView;
        If (What = evCommand) then ClearEvent (Event);
        end;
      end;
    evKeyboard:
      begin
      If ((KeyCode = kbPgUp) or (KeyCode = kbUp)) and (CurrentRecord = 0) then
        KeyCode := kbShiftTab;
      If ((KeyCode = kbPgDn) or (KeyCode = kbDown))
        and (succ (CurrentRecord) = Limit.Y)
       then
        KeyCode := kbTab;
      end;
    end;
      TDmxEditor.HandleEvent (Event);
      end;
end;


procedure TDmxForm.InitStruct (var ATemplate );
var  Items    : PSItem;
     i,Lim    : integer;
     AllZ    : boolean;
     S        : string;
begin
  Move (string (ATemplate) [1], Items, sizeof (Items));
  If (Items = nil) then Exit;
  FirstDataRow := -1;
  AllZ := (Items^.Value <> nil) and (Items^.Value^[1] = ^A);
  Repeat
    Inc (NumRows);
    Items := Items^.Next;
  Until (Items = nil);
  Move (string (ATemplate) [1], Items, sizeof (Items));
  GetMem (DMXfields, (NumRows * 4) + 200);
  i := 0;
  Lim := 0;
  While (Items <> nil) and (not LowMemory) do
    begin
    Limit.X := 0;
    DMXfield1 := nil;
    If (Items^.Value = nil) or (Items^.Value^ = '') or (Items^.Value^ = ^A) then
      S := ' '
     else
      S := Items^.Value^;
    If AllZ and (length (S) < pred (sizeof (S))) then Insert (^A, S, 1);
    TDmxEditor.InitStruct (S);
    If (FirstDataRow < 0) and (RecordSize > 0) then
      begin
      CurrentField := DMXfield1;
      While (CurrentField <> nil) and ((CurrentField^.fieldsize = 0)
     or (CurrentField^.access and (accHidden or accSkip) <> 0)) do
    CurrentField := CurrentField^.Next;
      If (CurrentField <> nil) then FirstDataRow := i;
      end;
    If (Lim < Limit.X) then Lim := Limit.X;
    DMXfields^ [i] := DMXfield1;
    Inc (i);
    Items := Items^.Next;
    end;
  Limit.X := Lim;
  DataBlockSize := RecordSize;
  DataBlockSize := DataBlockSize * NumRows;
  If (FirstDataRow >= 0) then CurrentRecord := FirstDataRow;
  DMXfield1 := DMXfields^[CurrentRecord];
  PrevRec := -1;
end;


procedure TDmxForm.SetUpField;
begin
  TDmxEditor.SetUpField;
  If InScrl and (CurrentField <> nil) and
     (upcase (CurrentField^.typecode) in [fldSTR, fldSTRNUM, fldCHAR, fldCHARNUM])
   then
    FirstKey := FALSE;
end;


procedure TDmxForm.SetupRecord;
var  i,n : integer;
     cmd : word;
     cf,was : pDMXfieldrec;
begin
  was := CurrentField;
  If (CurrentField = nil) then n := 0 else n := CurrentField^.screentab;
  DMXfield1 := DMXfields^ [CurrentRecord];
  CurrentField := DMXfield1;
  If (DMXfield1 <> nil) then
    begin
    While (CurrentField <> nil) and ((CurrentField^.fieldsize = 0) or
      (CurrentField^.access and (accHidden or accSkip) <> 0)) do
      CurrentField := CurrentField^.Next;
    If (CurrentField = nil) then
      begin
      If (CurrentRecord = 0) then PrevRec := -1;
      If (CurrentRecord = pred (Limit.Y)) then PrevRec := Limit.Y;
      If (PrevRec > CurrentRecord) then cmd := cmDMX_Up else cmd := cmDMX_Down;
      CurrentField := was;
      Message (@Self, evCommand, cmd, @Self);
      TDmxForm.SetupRecord;
      Exit;
      end
     else
      begin
      cf := CurrentField;
      While (cf <> nil) and (cf^.screentab <= n) do
    begin
    If (cf^.fieldsize > 0) and (cf^.access and (accHidden or accSkip) = 0)
     then CurrentField := cf;
    cf := cf^.Next;
    end;
      n := Delta.X;
      If (n + CurrentField^.screentab + CurrentField^.shownwid > Size.X) then
    n := CurrentField^.screentab + CurrentField^.shownwid - Size.X;
      If (n > CurrentField^.screentab) then n := CurrentField^.screentab;
      If (n <> Delta.X) then ScrollTo (n, Delta.Y);
      end;
    end;
  TDmxEditor.SetupRecord;
  PrevRec := CurrentRecord;
end;


procedure TDmxForm.StoreStruct (var S : TStream);
var  i : integer;
begin
  S.Write (InScrl,  sizeof (InScrl));
  S.Write (NumRows, sizeof (NumRows));
  S.Write (FirstDataRow, sizeof (FirstDataRow));
  If (NumRows > 0) then
    For i := 0 to pred (NumRows) do
      begin
      DMXfield1 := DMXfields^ [i];
      TDmxEditor.StoreStruct (S);
      end;
  PrevRec := -1;
end;


  { ══ TDmxDlgForm ═══════════════════════════════════════════════════════ }


constructor TDmxDlgForm.Init (ATemplates : PSItem;
            var Bounds : TRect;
            AHScrollBar,AVScrollBar : PScrollBar);
begin
  TDmxForm.Init (ATemplates, TRUE, Mem [0:0], Bounds, nil,nil, AHScrollBar, AVScrollBar);
end;


function  TDmxDlgForm.DataSize : word;
begin
  DataSize := RecordSize;
end;


procedure TDmxDlgForm.DoneData;
begin
  If (WorkingData <> nil) and (RecordSize > 0) then
    FreeMem (WorkingData, RecordSize);
end;


procedure TDmxDlgForm.GetData (var Rec );
begin
  Move (WorkingData^, Rec, DataSize);
end;


function  TDmxDlgForm.GetPalette : PPalette;
const  P : string [length (CDmxDlgForm)] = CDmxDlgForm;
begin
  GetPalette := @P
end;


procedure TDmxDlgForm.InitData (var AData );
begin
  If not LowMemory and (RecordSize > 0) then
    begin
    GetMem (WorkingData, RecordSize);
    FillChar (WorkingData^, RecordSize, 0);
    end;
end;


procedure TDmxDlgForm.SetData (var Rec );
begin
  Move (Rec, WorkingData^, DataSize);
end;


  { ══════════════════════════════════════════════════════════════════════ }


procedure RegisterDMXFORMS;
begin
  RegisterType (RDmxForm);
  RegisterType (RDmxDlgForm);
end;


  { ══════════════════════════════════════════════════════════════════════ }


End.