HagensTechiBlog

 
unit PrtGlob;
 
interface
 
uses Drivers, Objects, Dos, PrintDev, Views, Dialogs, Menus,
     Validate, ObjTools, AppTools;
 
const
  cmAbout = $A000;
 
  cmSelfTest = 101;
  cmDeviceTest = 102;
  cmPrinterReset = 103;
  cmSideOut = 104;
 
  cmOptions = $A010;
  cmListItemFocused = $A011;
  cmFindDeviceWindow = $A012;
 
  hcAbout = $A100;
  hcSelfTest = $A101;
  hcDeviceTest = $A102;
  hcPrinterReset = $A103;
  hcSideOut = $A104;
 
  hcOptions = $A110;
 
  hcMenus = $A000;
  hcMenuDevice = $A001;
  hcMenuTest = $A002;
  hcMenuOptions = $A003;
  hcMenuHelp = $A004;
  hcMenuWindows = $A005;
 
  hcHelpHow = $A100;
 
  hcDeviceWindow = $100;
  hcOptionsWindow = $101;
 
  hcFileOpenDialog = $B001;
  hcDeviceInputDialog = $B003;
  hcSelfTestWindow = $B005;
  hcAutomaticTest = $B006;
  hcLPTInput = $B007;
 
  HIDFileOpen = 1;
  HIDInputSequenz = 2;
  HIDNameInput = 3;
  HIDFileNameInput = 4;
 
  StreamBufSize: word = 2048;
 
  SMenuBar: string[7] = 'MenuBar';
  SMenuPopup: string[9] = 'MenuPopup';
  SStatusLine: string[10] = 'StatusLine';
  SAboutBox: string[8] = 'AboutBox';
  SFileOpenDialog: string[14] = 'FileOpenDialog';
  SPrinterFunctions: string[16] = 'PrinterFunctions';
  SDeviceInputDialog: string[21] = 'DeviceItemInputDialog';
  SOptionsWindow: string[14] = 'OptionsWindow';
  SCheckBox: string[8] = 'CheckBox';
  SSelfTestWindow: string[16] = 'TestStatusWindow';
  SDeviceWindow: string[11] = 'TestStatus2';
  STestText: string[13] = 'PrintTestText';
  SHintList: string[8] = 'HintList';
  SSystemMenu: string[10] = 'SystemMenu';
 
  erFileNotFound: string[31] = 'Treiberdatei %s nicht gefunden!';
  erSaveFile: string[48] = 'DOS-Fehler! Kann Treiberdatei nicht erzeugen: %s';
  erLoadFile: string[46] = 'Lade-Fehler! Kann Treiberdatei nicht laden: %s';
  erFileExists: string[65] = 'Es existiert bereits eine Treiberdatei "%s". Fortsetzen?';
  erNotFileExists: string[34] = 'Treiberdatei "%s" existiert nicht!';
  erNoFileName: string[40] = 'Es wurde noch kein Dateiname eingegeben!';
  erSaveModify: string[72] = 'Aktuelle Treiberdatei wurde ver�ndert. Speichern?'+
   #13#13'Drucker: %s'#13'Datei: %s';
  UnknownTitle: string[09] = 'Unbenannt';
  erOutOfMemory: string[43] = 'Zu wenig Speicher f�r gew�nschte Operation!';
  erDeviceInit: string[34] = 'Kann Treiber nicht initialisieren!';
  erLabelError: string[29] = 'Quellcode ver�ndert! Abbruch!';
  erHelpFileError = 'Kann Hilfedatei nicht laden!';
  wrShellMsg: string[56] = 'Geben Sie EXIT ein, um zu PrinterSetup zur�ckzukehren.'#13#10;
  ValidatorMask = '[&][&][&][&][&][&][&][&].PRD';
  ApplicationTitleStr: string[37] = 'PrinterSetup V1.0 - MakePrinterDevice';
  ApplicationTitle: PString = @ApplicationTitleStr;
 
const
 
{  stringlist  }
 
  SZur0cksetzen   : string[12] = 'Zur�cksetzen';
  SSelbstTest     : string[10] = 'SelbstTest';
  SUnterstreichenE: string[22] = 'Unterstreichen einzeln';
  SUnterstreichenD: string[22] = 'Unterstreichen doppelt';
  SUnterstreichenA: string[26] = 'Unterstreichen ausschalten';
  SDruckrichtungQu: string[24] = 'Druckrichtung Querformat';
  SDruckrichtungHo: string[24] = 'Druckrichtung Hochformat';
  SPapierformatSta: string[26] = 'Papierformat Standardgr��e';
  SPapierformatUSB: string[21] = 'Papierformat US-Brief';
  SPapierformatUSL: string[20] = 'Papierformat US-Lang';
  SPapierformatDIN: string[19] = 'Papierformat DIN A4';
  SPapierformatUSN: string[44] = 'Pap.form. US-Nr. 10-Umschlag (Querformat)';
  SZeilenabstandZe: string[26] = 'Zeilenabstand: Zeilen/Zoll';
  SSeitenl0ngeAnza: string[30] = 'Seitenl�nge: Anzahl der Zeilen';
  SObererRandAnzah: string[30] = 'Oberer Rand: Anzahl der Zeilen';
  STextl0ngeAnzahl: string[28] = 'Textl�nge: Anzahl der Zeilen';
  SSeitenr0nderL0s: string[21] = 'Seitenr�nder: L�schen';
  SSeitenr0nderLin: string[32] = 'Seitenr�nder: Links (Spalte Nr.)';
  SSeitenr0nderRec: string[33] = 'Seitenr�nder: Rechts (Spalte Nr.)';
  SZeichendichteAn: string[43] = 'Zeichendichte: Anzahl der Zeichen/Zoll';
  SSchriftlageAufr: string[21] = 'Schriftlage: Aufrecht';
  SSchriftlageKurs: string[19] = 'Schriftlage: Kursiv';
  SStrichst0rkeNor: string[20] = 'Strichst�rke: Normal';
  SStrichst0rkeFet: string[18] = 'Strichst�rke: Fett';
  SStrichst0rkeExt: string[24] = 'Strichst�rke: Extra Fett';
  SDruckqualit0tSc: string[27] = 'Druckqualit�t: Sch�nschrift';
  SDruckqualit0tEn: string[22] = 'Druckqualit�t: Entwurf';
  SZeichensatzDeut: string[29] = 'Zeichensatz: Deutsch (ISO 21)';
  SZeichensatzEngl: string[29] = 'Zeichensatz: Englisch (ISO 4)';
  SZeichensatzANSI: string[31] = 'Zeichensatz: ANSI ASCII (ISO 6)';
  SZeilenumbruchEi: string[25] = 'Zeilenumbruch einschalten';
  SZeilenumbruchAu: string[25] = 'Zeilenumbruch ausschalten';
  SSeiteAuswerfen : string[15] = 'Seite auswerfen';
  SNewLine:         string[10] = 'Neue Zeile';
{ string pointer table }
 
  PrinterFuncName: array[0..33] of PString = (
    @SZur0cksetzen,
    @SSelbstTest,
    @SUnterstreichenE,
    @SUnterstreichenD,
    @SUnterstreichenA,
    @SDruckrichtungQu,
    @SDruckrichtungHo,
    @SPapierformatSta,
    @SPapierformatUSB,
    @SPapierformatUSL,
    @SPapierformatDIN,
    @SPapierformatUSN,
    @SZeilenabstandZe,
    @SSeitenl0ngeAnza,
    @SObererRandAnzah,
    @STextl0ngeAnzahl,
    @SSeitenr0nderL0s,
    @SSeitenr0nderLin,
    @SSeitenr0nderRec,
    @SZeichendichteAn,
    @SSchriftlageAufr,
    @SSchriftlageKurs,
    @SStrichst0rkeNor,
    @SStrichst0rkeFet,
    @SStrichst0rkeExt,
    @SDruckqualit0tSc,
    @SDruckqualit0tEn,
    @SZeichensatzDeut,
    @SZeichensatzEngl,
    @SZeichensatzANSI,
    @SZeilenumbruchEi,
    @SZeilenumbruchAu,
    @SSeiteAuswerfen,
    @SNewLine);
 
 
type
 
  TMainOptions = record
    Base: wordbool;
    end;
 
  PDeviceListBox = ^TDeviceListBox;
  TDeviceListBox = object(TListBox)
    constructor Init(Bounds: TRect; AScrollBar: PScrollBar);
    procedure FocusItem(Item: Integer); virtual;
    function GetText(Item: integer; MaxLen: integer): string; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure NewList(AList: PCollection); virtual;
    procedure ResetList;
    end;
 
  TDeviceItemRec = record
    Num: byte;
    Item: PDeviceItem;
    end;
 
  PExtraInputLine = ^TExtraInputLine;
  TExtraInputLine = object(TInputLine)
    procedure HandleEvent(var Event: TEvent); virtual;
    end;
 
  PDeviceInputDialog = ^TDeviceInputDialog;
  TDeviceInputDialog = object(TDialog)
    Item: PDeviceItem;
    constructor Init;
    destructor Done; virtual;
    function DataSize: word; virtual;
    procedure GetData(var Rec); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SetData(var Rec); virtual;
    end;
 
  PGrayCheckBoxes = ^TGrayCheckBoxes;
  TGrayCheckBoxes = object(TCheckBoxes)
    constructor Init;
    function GetPalette: PPalette; virtual;
    end;
 
  POptionsWindow = ^TOptionsWindow;
  TOptionsWindow = object(TDialog)
    Cluster: PCluster;
    constructor Init;
    constructor Load(var S: TStream);
    procedure Close; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Store(var S: TStream);
    end;
 
  PHintStatusLine = ^THintStatusLine;
  THintStatusLine = object(TStatusLine)
    function Hint(AHelpCtx: Word): String; virtual;
    end;
 
const
  ResFile: PResourceFile = nil;
  HintList: PStringList = nil;
 
  MainOptions: TMainOptions =
    (Base: false);
 
 
 
procedure RegisterPrintSetup;
 
 
const
  RDeviceListBox: TStreamRec = (
    ObjType: $A000;
    VmtLink: ofs(TypeOf(TDeviceListBox)^);
    Load: @TDeviceListBox.Load;
    Store: @TDeviceListBox.Store);
 
const
  RExtraInputLine: TStreamRec = (
    ObjType: $A001;
    VmtLink: ofs(TypeOf(TExtraInputLine)^);
    Load: @TExtraInputLine.Load;
    Store: @TExtraInputLine.Store);
 
const
  RDeviceInputDialog: TStreamRec = (
    ObjType: $A002;
    VmtLink: ofs(TypeOf(TDeviceInputDialog)^);
    Load: @TDeviceInputDialog.Load;
    Store: @TDeviceInputDialog.Store);
 
const
  RGrayCheckBoxes: TStreamRec = (
    ObjType: $A003;
    VmtLink: ofs(TypeOf(TGrayCheckBoxes)^);
    Load: @TGrayCheckBoxes.Load;
    Store: @TGrayCheckBoxes.Store);
 
const
  ROptionsWindow: TStreamRec = (
    ObjType: $A004;
    VmtLink: ofs(TypeOf(TOptionsWindow)^);
    Load: @TOptionsWindow.Load;
    Store: @TOptionsWindow.Store);
 
const
  RHintStatusLine: TStreamRec = (
    ObjType: $A005;
    VmtLink: ofs(TypeOf(THintStatusLine)^);
    Load: @THintStatusLine.Load;
    Store: @THintStatusLine.Store);
 
implementation
 
uses App;
 
{ TExtraInputLine }
 
procedure TExtraInputLine.HandleEvent(var Event: TEvent);
const
  PadKeys = [$47, $4B, $4D, $4F, $73, $74];
var
  Delta, Anchor, I: Integer;
  ExtendBlock: Boolean;
  OldData: string;
  OldCurPos, OldFirstPos,
  OldSelStart, OldSelEnd: Integer;
  WasAppending: Boolean;
 
function MouseDelta: Integer;
var
  Mouse: TPoint;
begin
  MakeLocal(Event.Where, Mouse);
  if Mouse.X < = 0 then MouseDelta := -1 else
  if Mouse.X >= Size.X - 1 then MouseDelta := 1 else
  MouseDelta := 0;
end;
 
function MousePos: Integer;
var
  Pos: Integer;
  Mouse: TPoint;
begin
  MakeLocal(Event.Where, Mouse);
  if Mouse.X < 1 then Mouse.X := 1;
  Pos := Mouse.X + FirstPos - 1;
  if Pos < 0 then Pos := 0;
  if Pos > Length(Data^) then Pos := Length(Data^);
  MousePos := Pos;
end;
 
procedure DeleteSelect;
begin
  if SelStart <> SelEnd then
  begin
    Delete(Data^, SelStart + 1, SelEnd - SelStart);
    CurPos := SelStart;
  end;
end;
 
procedure AdjustSelectBlock;
begin
  if CurPos < Anchor then
  begin
    SelStart := CurPos;
    SelEnd := Anchor;
  end else
  begin
    SelStart := Anchor;
    SelEnd := CurPos;
  end;
end;
 
procedure SaveState;
begin
  if Validator <> nil then
  begin
    OldData := Data^;
    OldCurPos := CurPos;
    OldFirstPos := FirstPos;
    OldSelStart := SelStart;
    OldSelEnd := SelEnd;
    WasAppending := Length(Data^) = CurPos;
  end;
end;
 
procedure RestoreState;
begin
  if Validator <> nil then
  begin
    Data^ := OldData;
    CurPos := OldCurPos;
    FirstPos := OldFirstPos;
    SelStart := OldSelStart;
    SelEnd := OldSelEnd;
  end;
end;
 
function CheckValid(NoAutoFill: Boolean): Boolean;
var
  OldLen: Integer;
  NewData: String;
begin
  if Validator <> nil then
  begin
    CheckValid := False;
    OldLen := Length(Data^);
    if (Validator^.Options and voOnAppend = 0) or
      (WasAppending and (CurPos = OldLen)) then
    begin
      NewData := Data^;
      if not Validator^.IsValidInput(NewData, NoAutoFill) then
        RestoreState
      else
      begin
        if Length(NewData) > MaxLen then NewData[0] := Char(MaxLen);
        Data^ := NewData;
        if (CurPos >= OldLen) and (Length(Data^) > OldLen) then
          CurPos := Length(Data^);
        CheckValid := True;
      end;
    end
    else
    begin
      CheckValid := True;
      if CurPos = OldLen then
        if not Validator^.IsValidInput(Data^, False) then
        begin
          Validator^.Error;
          CheckValid := False;
        end;
    end;
  end
  else
    CheckValid := True;
end;
 
function CanScroll(Delta: Integer): Boolean;
begin
  if Delta < 0 then
    CanScroll := FirstPos > 0 else
  if Delta > 0 then
    CanScroll := Length(Data^) - FirstPos + 2 > Size.X else
    CanScroll := False;
end;
 
var
  MaxMode: byte;
begin
  MaxMode := byte(not MainOptions.Base) + 3;
  TView.HandleEvent(Event);
  if State and sfSelected <> 0 then
  begin
    case Event.What of
      evMouseDown:
        begin
          Delta := MouseDelta;
          if CanScroll(Delta) then
          begin
            repeat
              if CanScroll(Delta) then
              begin
                Inc(FirstPos, Delta);
                DrawView;
              end;
            until not MouseEvent(Event, evMouseAuto);
          end else
          if Event.Double then SelectAll(True) else
          begin
            Anchor := MousePos;
            repeat
              if Event.What = evMouseAuto then
              begin
                Delta := MouseDelta;
                if CanScroll(Delta) then Inc(FirstPos, Delta);
              end;
              CurPos := MousePos;
              AdjustSelectBlock;
              DrawView;
            until not MouseEvent(Event, evMouseMove + evMouseAuto);
          end;
          ClearEvent(Event);
        end;
      evKeyDown:
        begin
          SaveState;
          Event.KeyCode := CtrlToArrow(Event.KeyCode);
          if (Event.ScanCode in PadKeys) and
             (GetShiftState and $03 <> 0) then
          begin
            Event.CharCode := #0;
            if CurPos = SelEnd then Anchor := SelStart
            else Anchor := SelEnd;
            ExtendBlock := True;
          end
          else
            ExtendBlock := False;
          case Event.KeyCode of
            kbLeft:
              if CurPos > 0 then
              begin
                Dec(CurPos);
                if CurPos > 1 then
                  if Data^[CurPos + 1] = #32 then Dec(CurPos);
              end;
            kbRight:
              if CurPos < Length(Data^) then
              begin
                Inc(CurPos);
                if Data^[CurPos + 1] = #32 then Inc(CurPos);
                if (CurPos = length(Data^)) and (length(Data^) < MaxLen) and
                  (CurPos mod MaxMode = MaxMode - 1) then
                begin
                  Inc(CurPos);
                  Insert(#32, Data^, CurPos);
                end;
                CheckValid(True);
              end;
            kbHome:
              CurPos := 0;
            kbEnd:
              begin
                CurPos := Length(Data^);
                if (CurPos = length(Data^)) and (length(Data^) < MaxLen) and
                  (CurPos mod MaxMode = MaxMode - 1) then
                begin
                  Inc(CurPos);
                  Insert(#32, Data^, CurPos);
                end;
                CheckValid(True);
              end;
            kbBack:
             begin
              if CurPos > 0 then
              begin
                Delete(Data^, CurPos, 1);
                Dec(CurPos);
                if FirstPos > 0 then Dec(FirstPos);
                CheckValid(True);
              end;
              if (CurPos > 1) and (Data^[CurPos+1] = #32) then
              begin
                Delete(Data^, CurPos, 1);
                Dec(CurPos);
                if FirstPos > 0 then Dec(FirstPos);
                CheckValid(True);
              end;
             end;
            kbDel:
              begin
                if SelStart = SelEnd then
                  if CurPos < Length(Data^) then
                  begin
                    SelStart := CurPos;
                    SelEnd := CurPos + 1;
                  end;
                DeleteSelect;
                CheckValid(True);
              end;
            kbIns:
              SetState(sfCursorIns, State and sfCursorIns = 0);
          else
            case Event.CharCode of
              #33..#102:
                begin
                  if Event.Charcode in ['a'..'z'] then Event.Charcode :=
                    system.upcase(Event.Charcode);
                  if State and sfCursorIns <> 0 then
                    Delete(Data^, CurPos + 1, 1) else DeleteSelect;
                  if CheckValid(True) then
                  begin
                    if Event.Charcode = '#' then
                    begin
                      if Length(Data^) + MaxMode < MaxLen then
                      begin
                        if Data^[CurPos + 1] <> '#' then
                        begin
                          if MainOptions.Base then
                          begin
                            Insert(' ##', Data^, CurPos);
                            Inc(CurPos, 3);
                          end
                          else
                          begin
                            Insert(' ###', Data^, CurPos);
                            Inc(CurPos, 4);
                          end;
                        end
                        else
                        begin
                          Insert('#', Data^, CurPos);
                          Inc(CurPos);
                          if CurPos mod MaxMode = MaxMode - 1 then
                            if (Length(Data^) + 1 < MaxLen) and
                            (Data^[CurPos] <> #32) then
                            begin
                              Inc(CurPos);
                              Insert(#32, Data^, CurPos);
                            end;
                        end;
                      end;
                    end
                    else
                    if Length(Data^) < MaxLen then
                    begin
                      if FirstPos > CurPos then FirstPos := CurPos;
                      Inc(CurPos);
                      Insert(Event.CharCode, Data^, CurPos);
                      if CurPos mod MaxMode = MaxMode - 1 then
                        if (Length(Data^) + 1 < MaxLen) and
                          (Data^[CurPos] <> #32) then
                        begin
                          Inc(CurPos);
                          Insert(#32, Data^, CurPos);
                        end;
                    end;
                    CheckValid(False);
                  end;
                end;
              ^Y:
                begin
                  Data^ := '';
                  CurPos := 0;
                end;
            else
              Exit;
            end
          end;
          if ExtendBlock then
            AdjustSelectBlock
          else
          begin
            SelStart := CurPos;
            SelEnd := CurPos;
          end;
          if FirstPos > CurPos then FirstPos := CurPos;
          I := CurPos - Size.X + 2;
          if FirstPos < I then FirstPos := I;
          DrawView;
          ClearEvent(Event);
        end;
    end;
  end;
end;
 
{ TDeviceList }
 
constructor TDeviceListBox.Init(Bounds: TRect; AScrollBar: PScrollBar);
begin
  inherited Init(Bounds, 1, AScrollBar);
  GrowMode := gfGrowHiY or gfGrowHiX;
end;
 
procedure TDeviceListBox.FocusItem(Item: Integer);
begin
  inherited FocusItem(Item);
  Message(Owner, evBroadCast, cmListItemFocused, @self);
  DrawView;
end;
 
function TDeviceListBox.GetText(Item: integer; MaxLen: integer): string;
var
  Str: string;
begin
  FillChar(Str[1], MaxLen - 1, #32);
  Str := PrinterFuncName[Item]^;
  Str[0] := #35;
  Str[35] := #179;
  Str := Str + GetDeviceItemStr(List^.At(Item), MainOptions.Base);
  GetText := copy(Str, 1, MaxLen);
end;
 
procedure TDeviceListBox.HandleEvent(var Event: TEvent);
 
procedure FocusItemNum(Item: Integer);
begin
  if Item < 0 then Item := 0
  else if (Item >= Range) and (Range > 0) then Item := Range-1;
  if Range <> 0 then FocusItem(Item);
end;
 
 
const
  MouseAutosToSkip = 4;
var
  Mouse: TPoint;
  ColWidth: Word;
  OldItem, NewItem: Integer;
  Count: Word;
begin
  TView.HandleEvent(Event);
  if Event.What = evMouseDown then
  begin
    ColWidth := Size.X div NumCols + 1;
    OldItem := Focused;
    MakeLocal(Event.Where, Mouse);
    if MouseInView(Event.Where) then
      NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
    else NewItem := OldItem;
    Count := 0;
    repeat
{      if NewItem <> OldItem then}
      begin
        FocusItemNum(NewItem);
        SelectItem(NewItem);
        ClearEvent(Event);
        DrawView;
        exit;
      end;
      OldItem := NewItem;
      MakeLocal(Event.Where, Mouse);
      if MouseInView(Event.Where) then
        NewItem := Mouse.Y + (Size.Y * (Mouse.X div ColWidth)) + TopItem
      else
      begin
        if NumCols = 1 then
        begin
          if Event.What = evMouseAuto then Inc(Count);
          if Count = MouseAutosToSkip then
          begin
            Count := 0;
            if Mouse.Y < 0 then NewItem := Focused-1
            else if Mouse.Y >= Size.Y then NewItem := Focused+1;
          end;
        end
        else
        begin
          if Event.What = evMouseAuto then Inc(Count);
          if Count = MouseAutosToSkip then
          begin
            Count := 0;
            if Mouse.X < 0 then NewItem := Focused-Size.Y
            else if Mouse.X >= Size.X then NewItem := Focused+Size.Y
            else if Mouse.Y < 0 then
              NewItem := Focused - Focused mod Size.Y
            else if Mouse.Y > Size.Y then
              NewItem := Focused - Focused mod Size.Y + Size.Y - 1;
          end
        end;
      end;
    until not MouseEvent(Event, evMouseMove + evMouseAuto);
    FocusItemNum(NewItem);
    DrawView;
    if Event.Double and (Range > Focused) then SelectItem(Focused);
    ClearEvent(Event);
  end
  else if Event.What = evKeyDown then
  begin
    if (Event.CharCode in [' ', #13]) and (Focused < Range) then
    begin
      SelectItem(Focused);
      NewItem := Focused;
    end
    else case CtrlToArrow(Event.KeyCode) of
      kbUp: NewItem := Focused - 1;
      kbDown: NewItem := Focused + 1;
      kbRight: if NumCols > 1 then NewItem := Focused + Size.Y else Exit;
      kbLeft: if NumCols > 1 then NewItem := Focused - Size.Y else Exit;
      kbPgDn: NewItem := Focused + Size.Y * NumCols;
      kbPgUp: NewItem := Focused - Size.Y * NumCols;
      kbHome: NewItem := TopItem;
      kbEnd: NewItem := TopItem + (Size.Y * NumCols) - 1;
      kbCtrlPgDn: NewItem := Range - 1;
      kbCtrlPgUp: NewItem := 0;
    else
      Exit;
    end;
    FocusItemNum(NewItem);
    DrawView;
    ClearEvent(Event);
  end else if Event.What = evBroadcast then
    if Options and ofSelectable <> 0 then
      if (Event.Command = cmScrollBarClicked) and
         ((Event.InfoPtr = HScrollBar) or (Event.InfoPtr = VScrollBar)) then
        Select
      else if (Event.Command = cmScrollBarChanged) then
      begin
        if (VScrollBar = Event.InfoPtr) then
        begin
          FocusItemNum(VScrollBar^.Value);
          DrawView;
        end else if (HScrollBar = Event.InfoPtr) then DrawView;
      end;
end;
 
procedure TDeviceListBox.NewList(AList: PCollection);
begin
  inherited NewList(AList);
  SetRange(34);
end;
 
procedure TDeviceListBox.ResetList;
begin
  SetRange(34);
  DrawView;
end;
 
{ TDeviceInputDialog }
 
constructor TDeviceInputDialog.Init;
var
  R: TRect;
  Control: PView;
begin
  R.Assign(0, 0, 43, 10);
  inherited Init(R, 'Eingabe');
  Options := Options or ofCentered;
 
  { InputLine.InputLine }
  R.Assign(2, 3, 38, 4);
  Control := New(PExtraInputLine, Init(R, DeviceItemLen * 4));
  Insert(Control);
  { InputLine.History }
  R.Assign(38, 3, 41, 4);
  Insert(New(PHistory, Init(R, PInputLine(Control), HIDInputSequenz)));
  { InputLine.Label }
  R.Assign(1, 2, 15, 3);
  Insert(New(PLabel, Init(R, 'Escapesequenz:', Control)));
 
  { Buttons }
  R.Assign(1, 7, 14, 9);
  Insert(NewOKButton(R));
  R.Move(13, 0);
  Insert(NewCancelButton(R));
  R.Move(14, 0);
  Insert(NewHelpButton(R));
 
  SelectNext(false)
end;
 
destructor TDeviceInputDialog.Done;
begin
  inherited Done;
end;
 
function TDeviceInputDialog.DataSize: word;
begin
  DataSize := sizeof(TDeviceItemRec);
end;
 
procedure TDeviceInputDialog.GetData(var Rec);
var
  Data: TDeviceItemRec;
  NewItem: PDeviceItem;
  DataStr: string[DeviceItemLen * 4];
begin
  inherited GetData(DataStr);
  Item^ := GetDeviceItem(DataStr, MainOptions.Base);
  Data.Item := Item;
  TDeviceItemRec(Rec) := Data;
end;
 
procedure TDeviceInputDialog.HandleEvent(var Event: TEvent);
begin
  if (State and sfSelected = sfSelected) and (Event.What = evKeyDown) and
    (Event.KeyCode = kbEnter) and (GetHelpCTX <> hcHelpButton) then
  begin
    Event.What := evCommand;
    Event.Command := cmOK;
  end;
  inherited HandleEvent(Event);
end;
 
procedure TDeviceInputDialog.SetData(var Rec);
var
  DataStr: string[DeviceItemLen * 4];
  Data: TDeviceItemRec;
begin
  Data := TDeviceItemRec(Rec);
  Item := Data.Item;
  DataStr := GetDeviceItemStr(Item, MainOptions.Base);
  DisposeStr(Title);
  Title := NewStr(PrinterFuncName[Data.Num]^);
  inherited SetData(DataStr);
  Frame^.DrawView;
end;
 
 
{ TGrayCheckBoxes }
 
constructor TGrayCheckBoxes.Init;
var
  R: TRect;
begin
  R.Assign(28, 5, 73, 6);
  inherited Init(R,
    NewSItem('automatisch nach Druckernamen bestimmen', nil));
  GrowMode := gfGrowLoY and gfGrowHiY or gfGrowLoX or gfGrowHiX;
end;
 
function TGrayCheckBoxes.GetPalette: PPalette;
const
  P: String[Length(CCluster)] = #1#2#3#4#5#6;
begin
  GetPalette := @P;
end;
 
constructor TOptionsWindow.Init;
var
  R: TRect;
begin
  R.Assign(0, 0, 30, 7);
  inherited Init(R, 'Optionen');
  HelpCTX := hcOptions;
  Options := Options or ofCenterX;
 
  R.Assign(5, 3, 25, 5);
  Cluster := (New(PRadioButtons, Init(R,
    NewSItem('Dezimal',
    NewSItem('Hexadezimal', nil)))));
  Cluster^.SetData(MainOptions.Base);
  Insert(Cluster);
  R.Assign(1, 2, 28, 3);
  Insert(New(PLabel, Init(R, 'Basis f�r Escapesequenz:', Cluster)));
end;
 
constructor TOptionsWindow.Load(var S: TStream);
begin
  inherited Load(S);
  GetSubViewPtr(S, Cluster);
  Cluster^.SetData(MainOptions.Base)
end;
 
procedure TOptionsWindow.Close;
begin
  Hide;
end;
 
procedure TOptionsWindow.HandleEvent(var Event: TEvent);
var
  OldValue: wordbool;
  NewValue: wordbool;
begin
  Cluster^.GetData(OldValue);
  inherited HandleEvent(Event);
  Cluster^.GetData(NewValue);
  if NewValue <> OldValue then MainOptions.Base := NewValue;
  Application^.Redraw;
end;
 
procedure TOptionsWindow.Store(var S: TStream);
begin
  inherited Store(S);
  PutSubViewPtr(S, Cluster);
end;
 
function THintStatusLine.Hint(AHelpCtx: Word): String;
begin
  Hint := HintList^.Get(AHelpCTX);
end;
 
 
procedure RegisterPrintSetup;
begin
  RegisterType(RDeviceListBox);
  RegisterType(RExtraInputLine);
  RegisterType(RDeviceInputDialog);
  RegisterType(RGrayCheckBoxes);
  RegisterType(ROptionsWindow);
  RegisterType(RHintStatusLine);
end;
 
 
end.

 
Program PrinterSetup;
 
{not$DEFINE EXEPROG}
{$DEFINE Overlay}
 
{$IFNDEF EXEPROG}
 
{$O+,F+,V-,X+,I-,S+,R+}
 
{$ELSE}
 
{$O+,F+,V-,X+,I-,S-,R-,D-,E-,G-,L-,N-,Q-,R-,Y-}
 
{$ENDIF EXEPROG}
 
uses {$IFDEF Overlay} Overlay, {$ENDIF}
     Drivers, Objects, ObjTools, SolDos, Strings,
     Menus, Validate, Views, Dialogs, App,
     AppTools, FileOpen, Dos, GmMsgBox, sDesk,
     PrtGlob, PrintDev, PrtViews,
     Crt, HistList, HelpFile;
 
{$IFDEF Overlay}
 
{$O Menus}
{$O Validate}
{$O PrintDEV}
{$O HelpFile}
{$O GmMsgBox}
{$O Histlist}
{$O AppTools}
{$O Screen}
 
{$ENDIF}
 
const
  LabelSum = 33524;
 
type
  PSetupApp = ^TSetupApp;
  TSetupApp = object(TS2Application)
    OptionsWindow: POptionsWindow;
    constructor Init;
    destructor Done; virtual;
    procedure AboutBox; virtual;
    function GetHelpFileName: FNameStr; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function HandleSystemButton: word; virtual;
    procedure Idle; virtual;
    procedure InitApphead; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure InsertDeviceWindow(const FileName: FNameStr); virtual;
    procedure NewDevice;
    procedure OpenDevice;
    procedure OutOfMemory; virtual;
    procedure WriteShellMsg; virtual;
    end;
 
 
procedure LabelHaver; assembler;
asm
  db '3,10;
  db '     � PrinterSetup V1.0 MakePrinterDevice �',13,10;
  db '     =======================================',13,10;
  db '         -  written H. H�bel Jan 1996  -',13,10;
  db '   (C), (P) S.O.L.Productions / ruLe_eXcess 1996',13,10;
  db '3,10;
  db 0,64,0,64,0,6,6,6;
end;
 
procedure WriteLabel;
type
  TSLabel = array[0..1] of char;
var
  Lab: ^TSLabel;
begin
  Lab := @LabelHaver;
  WriteLn(Lab^);
end;
 
function GetLabelSum: word;
type
  TSLabel = array[0..1] of char;
var
  Lab: ^TSLabel;
  Len: word;
  I: word;
  Sum: word;
begin
  Lab := @LabelHaver;
  Len := StrLen(PChar(Lab));
  Sum := 0;
  {$R-}
  For I := 0 to Len do Inc(Sum, ord(Lab^[i]));;
  {$R+}
  GetLabelSum := Sum;
end;
 
procedure RegisterApplication;
begin
  RegisterMenus;
  RegisterObjects;
  RegisterViews;
  RegisterApp;
  RegisterDialogs;
  RegisterValidate;
  RegisterObjTools;
  RegisterFileOpen;
  RegisterPrintDEV;
  RegisterPrintSetup;
  RegisterHelpFile;
  RegisterSDesk;
  RegisterType(RStringList);
end;
 
{ TSetup application }
constructor TSetupApp.Init;
var
  {$IFNDEF EXEPROG}
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
  {$ENDIF}
  FileName: FNameStr;
begin
 
  {$IFDEF EXEPROG}
  FileName := ParamStr(0);
  {$ELSE}
  FSplit(ParamStr(0), Dir, Name, Ext);
  FileName := Dir + Name + '.res';
  {$ENDIF EXEPROG}
 
  { Resourcenstream initialisieren }
  ResFile := New(PResourceFile, Init(New(PBufStream, Init(FileName,
    stOpenRead, StreamBufSize))));
  { stringliste f�r Statuszeile initialisieren }
  HintList := PStringList(ResFile^.Get(SHintList));
  { PrintDEV.PrinterDialog setzen }
  PrinterDialog := StdPrinterDialog;
  { HelpCTX f�r LPTInputDialog setzen }
  hcLPTInputDialog := hcLPTInput;
  InitPrintDEV;
  inherited Init;
  { Optionen-Fenster }
  OptionsWindow := POptionsWindow(ResFile^.Get(SOptionsWindow));
  InsertWindow(OptionsWindow);
  OptionsWindow^.Hide;
  {$IFNDEF EXEPROG}
  Message(@self, evCommand, cmOpen, nil);
  {$ENDIF EXEPROG}
end;
 
destructor TSetupApp.Done;
begin
  inherited Done;
  Dispose(HintList, Done);
  Dispose(ResFile, Done);
  DonePrintDEV;
end;
 
procedure TSetupApp.AboutBox;
begin
  ExecuteDialog(PDialog(ResFile^.Get(SAboutBox)), nil);
end;
 
{procedure TSetupApp.GetEvent(var Event: TEvent);
var
  W: PWindow;
  HFile: PHelpFile;
  HelpStrm: PDosStream;
  CallHelpCTX: word;
const
  HelpInUse: Boolean = False;
begin
  inherited GetEvent(Event);
  case Event.What of
    evCommand:
      if ((Event.Command = cmHelp or (Event.Command = cmHelpContents))
        and not HelpInUse then
      begin
        HelpInUse := True;
        HelpStrm := New(PDosStream, Init(GetHlpFile, stOpenRead));
        HFile := New(PHelpFile, Init(HelpStrm));
        if HelpStrm^.Status <> stOk then
        begin
          MessageBox(erHelpFileError, nil, mfError + mfOkButton);
          Dispose(HFile, Done);
        end
        else
        begin
          CallHelpCTX := GetHelpCTX;
          case Event.Command of
            cmHelpContents: CallHelpCTX := hcHelpContents;
            end;
          W := New(PHelpWindow, Init(HFile, CallHelpCtx));
          if ValidView(W) <> nil then
          begin
            ExecView(W);
            Dispose(W, Done);
          end;
          ClearEvent(Event);
        end;
        HelpInUse := False;
      end;
  end;
end;                       }
 
function TSetupApp.GetHelpFileName: FNameStr;
var
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  FSplit(ParamStr(0), D, N, E);
  GetHelpFileName := D+N+'.hlp';
end;
 
procedure TSetupApp.HandleEvent(var Event: TEvent);
 
procedure CloseAll;
 
procedure Close(P: PView); far;
begin
  if P <> PView(Desktop^.Background) then
    Message(P, evCommand, cmClose, nil);
end;
 
begin
  Desktop^.ForEach(@Close);
end;
 
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  case Event.Command of
    cmAbout: AboutBox;
    cmCloseAll: CloseAll;
    cmNew: NewDevice;
    cmOpen: OpenDevice;
    cmOptions: with OptionsWindow^ do begin Select; Show; end;
    else exit;
    ClearEvent(Event);
    end;
end;
 
function TSetupApp.HandleSystemButton: word;
var
  Menu: PSystemMenu;
  R: TRect;
begin
  Menu := PSystemMenu(ResFile^.Get(SSystemMenu));
  HandleSystemButton := Application^.ExecView(Menu);
  Dispose(Menu, Done);
end;
 
procedure TSetupApp.Idle;
begin
  inherited Idle;
end;
 
procedure TSetupApp.InitApphead;
var
  R: TRect;
begin
  R.Assign(0, 0, ScreenWidth, 2);
  AppHead := New(PAppHead, Init(R, ApplicationTitle^));
end;
 
procedure TSetupApp.InitMenuBar;
var
  R: TRect;
begin
  R.Assign(1, 2, 79, 3);
  MenuBar := PMenuBar(ResFile^.Get(SMenuBar));
  MenuBar^.Locate(R);
end;
 
procedure TSetupApp.InitStatusLine;
var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := PHintStatusLine(ResFile^.Get(SStatusLine));
  StatusLine^.Locate(R);
end;
 
procedure TSetupApp.InsertDeviceWindow(const FileName: FNameStr);
var
  DeviceWindow: PDeviceWindow;
begin
  DeviceWindow := New(PDeviceWindow, Init(FileName));
  InsertWindow(DeviceWindow);
end;
 
procedure TSetupApp.NewDevice;
begin
  InsertDeviceWindow('');
end;
 
procedure TSetupApp.OpenDevice;
var
  FileName: FNameStr;
begin
  FileName := '*' + PrinterDeviceExt;
  if ExecuteDialog(POpenDeviceDialog(ResFile^.Get(SFileOpenDialog)), @FileName) <> cmCancel
  then InsertDeviceWindow(FileName);
end;
 
procedure TSetupApp.OutOfMemory;
begin
  MessageBox(erOutOfMemory, nil, mfError or mfOKButton);
end;
 
procedure TSetupApp.WriteShellMsg;
begin
  PrintStr(wrShellMsg);
end;
 
{ ---- HeapErrorFunc ----- }
 
function HeapFunc (Size: Word): Integer; far;
begin
  HeapFunc := 1;
end;
 
 
{$IFDEF Overlay}
function GetOverlayFilename: FNameStr;
 
{$IFNDEF EXEPROG}
var
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  FSplit(ParamStr(0), D, N, E);
  if D[Length(D)] <> '\' then D := D + '\';
  GetOverlayFilename := D + N + '.OVR';
{$ELSE}
begin
  GetOverLayFilename := ParamStr(0);
{$ENDIF EXEPROG}
 
end;
{$ENDIF Overlay}
 
var
  SetupApp: PSetupApp;
  SaveDir: DirStr;
begin
  if GetLabelSum <> LabelSum then
  begin
    TextAttr := SysColorAttr or blink;
    Write(erLabelError);
    Delay($FFFF);
    Halt(2)
  end;
  WriteLabel;
  HeapError := @HeapFunc;
 
  {$IFDEF Overlay}
 
  OvrInit(GetOverlayFilename);
  if OvrResult <> ovrOK then
  begin
    PrintStr('Abbruch! Fehler bei Initialisieren!'#13#10);
    Halt(2);
  end;
  OvrInitEMS;
 
  {$ENDIF Overlay}
 
  RegisterApplication;
  { bisherige Directory speichern }
  GetDir(0, SaveDir);
  { in Directory von PRTSETUP.EXE wechseln }
  ChDir(NotTDir(GetFileDir(ParamStr(0))));
  if SaveDir[length(SaveDir)] = '\' then Dec(SaveDir[0]);
  New(SetupApp, init);
  SetupApp^.Execute;
  Dispose(SetupApp, done);
  { in alte Directory zurück }
  ChDir(SaveDir);
end.

    // defining
    CGUID guid;
 
    // formatting
    cout < < guid << endl;
 
    // copying
    CGUID anotherGuid(guid);
 
    // comparing...
    if(anotherGuid != guid) {
        cout << "this can't be!" << endl;
    }
 
    // conversion
    std::string sGuid(guid);
 
    // stl-compatible
    vector myGuids;
    myGuids.push_back(guid);
    sort(myGuids.begin(), myGuids.end());
 
    // storing
    Archive ar;
    ar < < guid;     // reading     ar >> guid;