Stars of Shareware: Programmierung/SOURCE.mdf/programm/windows/pascal/turbpa/uhr.pa_/uhr.pa

Text File | 1993-03-07 | 6.5 KB | 209 lines

{*************************************************************************}
{*                                                                       *}
{* Project :                                                             *}
{* Unit    : Uhr.Pas                                                     *}
{*                                                                       *}
{* Author  : Uwe Janiak                                                  *}
{* Firm    :                                                             *}
{* Adress  : 1055 Berlin, Grellstra▀e 63                                 *}
{*                                                                       *}
{* Created : Montag, den 10. August 1992 um 22:06:06 Uhr                 *}
{* Update  :                                                             *}
{*                                                                       *}
{* Version : Basic source created by Dialog Engine 1.5                   *}
{*                                                                       *}
{*************************************************************************}

{$N+,F+}
Unit Uhr;

interface uses WinTypes, WinProcs, WObjects, WinTools, Strings;

CONST     {Im Dialog verwendete ID-Codes der Elemente}

          id_Uhr_TEST=100;
          id_Uhr_Help=998;

TYPE     {Fuer den Dialog verwendeter Datensatz}

          TRecUhr= record
                ExitID:word;
                vTEST:string;
          end;

VAR       VRecUhr:TRecUhr;

TYPE      {Definition des verwendeten Dialogfensters}
          PUhr = ^TUhr;
          TUhr = Object(TDlgWindow)

            DialogBackground:HBrush;
            DialogTextColor:Longint;
            DialogBkColor:Longint;
            ResName:string;
            FirstTimer:Integer;
            TimerInstalled:Boolean;
            ts_TEST:PSTATIC;

            {Konstruktionsmethoden}
            constructor Init(AParent:PWindowsObject;Name:PChar);
            procedure SetupWindow;virtual;
            procedure wmColor(var Msg:TMessage);virtual wm_CtlColor;
            procedure wmTimer(var Msg:TMessage);virtual wm_first + wm_timer;
            procedure OK(var Msg:TMessage);virtual id_first + id_Ok;
            procedure Cancel(var Msg:TMessage);virtual id_first + id_Cancel;
            procedure Help(var Msg:TMessage);virtual id_first + id_Uhr_Help;

            {Reaktionsmethoden}
            procedure wmTEST(var Msg:TMessage); virtual id_first+id_Uhr_TEST;

            {Lokale Methoden}
            function SaveDataToRecord:boolean;
            procedure CreateColorElements;
            procedure DeleteColorElements;

          end;

implementation

{$R C:\TPW\SOURCER\UHR.RES}

{*************************************************************************}
{*              Routinen zur Verwaltung des Dialogs                      *}
{*************************************************************************}

constructor TUhr.Init(AParent:PWindowsObject;Name:PChar);
  begin
    TDlgWindow.Init(AParent,Name);
    StrCopy(@ResName[1],Name);Str_Pas(ResName);
    CreateColorElements;
    ts_TEST:=New(PSTATIC,InitResource(@self,id_Uhr_TEST,255));
  end;

procedure TUhr.SetupWindow;
  var s:string;j:word;
  begin
    TDlgWindow.SetupWindow;
    With VRecUhr do
      begin
        s:=vTEST+#0;
        ts_TEST^.SetText(@s[1]);
      end;
    DlgPos(hWindow,ResName,WP_Load);
    FirstTimer:=0;
    TimerInstalled:=SetTimer(hWindow,$ff,100,nil)<>0;
    If not TimerInstalled then message('Die Systemresource fⁿr'+
      'den Starttimer ist nicht verfⁿgbar!',1);
  end;


procedure TUhr.wmColor;

  function id(code_von,code_bis:word):boolean;
  var i:word;ok:boolean;
  begin
    i:=code_von;
    repeat
      ok:=getdlgitem(hwindow,i)=msg.lparamlo;
      inc(i);
    until ok or (i>code_bis);
    id:=ok;
  end;

  var s:string;c,i,no:word;pw:twindow;
  begin
    no:=GetDlgCtrLID(msg.wparam);
    SetBkColor(Msg.wParam,DialogBkColor);
    SetTextColor(Msg.wParam,DialogTextColor);
    Msg.Result:=DialogBackground;
  end;

procedure TUhr.OK;
  var i:integer;
  begin
    If SaveDataToRecord then exit;
    DeleteColorElements;
    DlgPos(hWindow,ResName,WP_Save);
    If TimerInstalled then KillTimer(hWindow,$FF);
    EndDlg(i);
  end;

procedure TUhr.Cancel;
  var i:integer;
  begin
    DeleteColorElements;
    DlgPos(hWindow,ResName,WP_Save);
    If TimerInstalled then KillTimer(hWindow,$FF);
    EndDlg(i);
  end;

procedure TUhr.Help;
  begin
    message('Sie haben Hilfe zum Dialog TUhr angefordert. '+
            'Bitte fⁿgen Sie einen WinHelp-Aufruf in die Methode Help'+
            ' ein, oder rufen Sie Ihre eigene Hilferoutine auf.',17);
  end;
procedure TUhr.wmTimer;
  var i:integer;s:string;
  begin
    Inc(FirstTimer);
    If FirstTimer=1 then
      begin
        If TimerInstalled then KillTimer(hWindow,$FF);
        TimerInstalled:=SetTimer(hWindow,$FF,1000,nil)<>0;
        If not TimerInstalled then message('Die Systemresource fⁿr'+
          'den Standardtimer ist nicht verfⁿgbar!',1);
        exit;
      end;

    {------ Hier die Standardbehandlung fⁿr das Timerevent ergΣnzen! ----}
    s:=timestring+#0;
    setwindowtext(hwindow,@s[1]);

  end;
procedure TUhr.CreateColorElements;
  begin
    DialogBackground:=CreateSolidBrush($FFFFFF);
    DialogTextColor:=$000000;
    DialogBkColor:=$FFFFFF;
  end;

procedure TUhr.DeleteColorElements;
  begin
    DeleteObject(DialogBackground);
  end;

{*************************************************************************}
{*              Reaktionsmethoden der einzelnen Dialogelemente           *}
{*************************************************************************}

procedure TUhr.wmTEST(var Msg:TMessage);
  begin
    DefWndProc(Msg);
  end;

{*************************************************************************}
{*              Lokale Routinen zur Verwaltung des Dialogs               *}
{*************************************************************************}

function TUhr.SaveDataToRecord:boolean;
  begin
    SaveDataToRecord:=false;
    With VRecUhr do
      begin
        ts_TEST^.GetText(@vTEST[1],255);str_pas(vTEST);
      end;
  end;

begin

{*************************************************************************}
{*        Belegung der Dialogelemente nach dem Programmstart             *}
{*************************************************************************}

    With VRecUhr do
      begin
        vTEST:='';
      end;
end.