The Education Master 1994 (4th Edition)/EDUCATIONS_MASTER_4TH_EDITION.bin/files/windties/paprexps/textstrm.pas

Pascal/Delphi Source File | 1991-11-26 | 5KB | 216 lines

{TextStrm - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit TextStrm;
{$R TextStrm.res}
{**********************  Interface  *************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,WFPlus;
type
PTextStream = ^TTextStream ;
TTextStream = object(TBufStream)
   CharsToRead : LongInt;
   CharsRead : LongInt;
   ARecord :PChar;
   constructor Init(FileName:PChar;Mode,Size:Word);
   destructor Done;virtual;
   function GetNext:PChar;virtual;
   function WriteNext(szARecord:PChar):integer;virtual;
   function WriteEOF:integer;virtual;
   function IsEOF:Boolean;virtual;
   function GetPctDone:Integer;
end;

type
PMeterWindow = ^TMeterWindow;
TMeterWindow = object(TWindow)
  TheRedBrush:HBrush;
  TheGrayBrush:Hbrush;
  ThePen:HPen;
  X,Y,dX,dY,mX :Integer;
  PctDone :Integer;
  Icon:HIcon;
  constructor Init(AParent:PWindowsObject;ATitle:PChar);
  procedure   SetupWindow;virtual;
  destructor  Done; virtual;
  procedure   Draw(NewPctDone:Integer);virtual;
  procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
end;
{************************  Implementation        ********************}
implementation
{************************  TTextStream         **********************}
constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
begin
    TBufStream.Init(FileName,Mode,Size);
  CharsRead := 0;
  CharsToRead := TBufStream.GetSize;
  ARecord := MemAlloc(32000);
end;

destructor TTextStream.Done;
begin
    TBufStream.Done;
  FreeMem(ARecord,32000);
end;

{replace unwanted control chars with spaces 10/5/91}
function TTextStream.GetNext:PChar;
var
    Blksize:Integer;
  AChar:Char;
  Indx : Integer;
  IsEOR : Boolean;
begin
    Indx := 0;
  IsEOR := False;
  ARecord[0] := #0;
  while (CharsRead < CharsToRead) and (IsEOR = False) do
      begin
      TBufStream.Read(AChar,1);
    Inc(CharsRead);
    case AChar of
      #13:
          begin
        ARecord[Indx] := #0;
        IsEOR := True;
        end;
        #26:
          begin
        if Indx > 0 then
            begin
          ARecord[Indx] := #0;
          IsEOR := True;
          end;
        end;
      #10:
          begin
        end;
      #9:
          begin
        ARecord[Indx] := AChar;
        Inc(Indx);
        end;
      #0..#31:
          begin
        ARecord[Indx] := ' ';
        Inc(Indx);
        end;
      else
          begin
        ARecord[Indx] := AChar;
        inc(Indx);
        end;
    end;
  end;
  ARecord[Indx] := #0;
  GetNext := ARecord;
end;

{This method not actually used due to performance loss - instead
   TStream.Write is called directly}
function TTextStream.WriteNext(szARecord:PChar):Integer;
const
  CRLF : Array[0..2] of Char = #13#10#0;
begin
    TBufStream.Write(szARecord,
    StrLen(szARecord));
    TBufStream.Write(CRLF,2);
    WriteNext := StrLen(szARecord);
end;

function TTextStream.WriteEOF:Integer;
const
      EOF : Array[0..1] of Char  = #26;
begin
    TBufStream.Write(EOF,1);
   WriteEOF := 1;
end;

function TTextStream.IsEOF:Boolean;
begin
    IsEOF := False;
    if CharsRead >= CharsToRead then
       IsEOF := True;
end;

function TTextStream.GetPctDone:Integer;
begin
    GetPctDone := CharsRead*100 div CharsToRead;
end;


{***************************  TMeterWindow  ***********************}
constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
begin
    TWindow.Init(AParent,ATitle);
  DisableAutoCreate;
     ThePen := CreatePen(ps_Solid,0,$00000000);
  TheGrayBrush := CreateSolidBrush($00C0C0C0);
  TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  with Attr do
       begin
      X := 100;Y :=100 ;W := 350;H := 95;
      Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
       end;
  X := 50;
  Y := 10;
  dX := 275;
  dY := 30;
  mX := 50;   {midpoint between X & X+dX}
  PctDone := 0;
end;

procedure TMeterWindow.SetupWindow;
begin
    TWindow.SetupWindow;
    Icon :=LoadIcon(HInstance,'TS_Icon1');
end;

destructor TMeterWindow.Done;
begin
     DeleteObject(TheGrayBrush);
  DeleteObject(TheRedBrush);
  DeleteObject(ThePen);
  TWindow.Done;
end;

procedure TMeterWindow.Draw(NewPctDone:Integer);
var
Rgn:TRect;
begin
    PctDone := NewPctDone;
    If PctDone > 0 then
       mX :=  X + ((dX * PctDone) div 100)
   else
       mX := X;
   Rgn.Left := X;
   Rgn.Top := Y;
   Rgn.Right := Max(210,mx);
   Rgn.Bottom := Y+dY+20;
   InvalidateRect(HWindow,@Rgn,false);
   UpdateWindow(HWindow);
end;

procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
    OldBrush : HBrush;
  OldPen :HPen;
  OldColor : LongInt;
  OldBkMode : Integer;
  Buf  : Array[0..6] of Char;
begin
    DrawIcon(PaintDC,10,10,Icon);
  OldPen := SelectObject(PaintDC,ThePen);
  OldBrush := SelectObject(PaintDC,TheGrayBrush);
  Rectangle(PaintDC,X,Y,mX,Y+dY);
  Str(PctDone:2, Buf);
  StrCat(Buf,'%');
  SetTextAlign(PaintDC,ta_left);
  OldColor := SetTextColor(PaintDC,RGB(255,0,0));  {Red}
  {OldBkMode := SetBkMode(PaintDC,Transparent);}
  TextOut(PaintDC,180,42,Buf,StrLen(Buf));
  SelectObject(PaintDC,OldBrush);
  SelectObject(PaintDC,OldPen);
  SetTextColor(PaintDC,Oldcolor);
  {SetBkMode(PaintDC,OldBkMode);}
end;
end.