Browse Source

- doesn't work as it is

Tomas Hajny 25 years ago
parent
commit
022512a61d
1 changed files with 0 additions and 200 deletions
  1. 0 200
      rtl/os2/tests/divetry.pas

+ 0 - 200
rtl/os2/tests/divetry.pas

@@ -1,200 +0,0 @@
-{****************************************************************************
-
-    $Id$
-
-                             DIVE example code
-             Copyright (c) 1999-2000 by Karoly Balogh (aka Charlie/INQ)
-
-****************************************************************************}
-
-{$ASMMODE INTEL}
-
-{ lame code, but who cares? :) please don't laugh it out. :) }
-
-Program DiveTry;
-
-{$I-}
-
-Uses Os2Def,PMWin,DIVE,DOSCalls;
-
-{ * main program * }
-Const ClassName      = 'MYVIEW';
-      idClientWindow = 11000;
-
-      WinFlags       : Cardinal = fcf_TitleBar+fcf_SysMenu+fcf_SizeBorder+
-                                  fcf_MinMax+fcf_TaskList+fcf_NoByteAlign;
-Var Anchor, MsgQue : Cardinal;
-    Message        : TQMsg;
-    Frame, Client  : Cardinal;
-
-    Picture     : Pointer;
-    PicSize     : DWord;
-
-    DIVEHandle      : HDIVE;
-    FrameBuffer     : Pointer;
-    DIVEImageBuffer : DWord;
-    DIVEColorFormat : DWord;
-
-    idBlitThread : DWord;
-
-    DIVEBlitSetup   : TSetup_Blitter;
-
-{ * The exported procedure * }
-Function ClientWindowProc(Window, Msg : DWord; MP1, MP2: Pointer) : Pointer; cdecl; Export;
-Var Li  : LongInt;
-    PS  : DWord;
-    R   : TRectL;
-    P   : TPointL;
-    Rgn : DWord;
-    DIVEBlitSetup : TSetup_Blitter;
-    DestFormat : DWord;
-Begin
- ClientWindowProc:=Nil;
- Case Msg Of
-   wm_Paint: Begin
-               PS:=WinBeginPaint(Window,0,@r);
-               WinFillRect(PS,@r,SYSCLR_WINDOW);
-
-               Asm
-                MOV EAX,'565R'
-                MOV DestFormat,EAX
-               End;
-
-               With DIVEBlitSetup Do Begin
-                 ulStructLen := SizeOf(DIVEBlitSetup); { * Whole record used * }
-                 fInvert     := 0;  { * Not inverted * }
-                 { * This is the mark for 8 bytes * }
-                 fccSrcColorFormat:=DIVEColorFormat; { * Source data format * }
-                 ulSrcWidth:=640;  { * Width in pels  * }
-                 ulSrcHeight:=480; { * Height in pels * }
-                 ulSrcPosX:=0; { * X Position of source data * }
-                 ulSrcPosY:=0; { * Y Position of source data * }
-                 { * This is the mark for 28 bytes * }
-                 ulDitherType:=0; { * Dither type * }
-                 { * 32 byte mark * }
-                 fccDstColorFormat:=DestFormat; { * Destination color format   * }
-                 ulDstWidth:=640; { * Destination width in pels  * }
-                 ulDstHeight:=480; { * Destination height in pels * }
-                 lDstPosX:=0;
-                 lDstPosY:=0;
-                 { * 52 byte mark * }
-                 lScreenPosX:=0;
-                 lScreenPosY:=0;
-                 { * 60 byte mark * }
-                 ulNumDstRects:=1;
-                 pVisDstRects:=@r; { * This is a pointer to an array of visible rectangles. * }
-                 { * 68 bytes = fully used * }
-                End;
-
-               If DIVESetupBlitter(DIVEHandle,@DIVEBlitSetup)<>DIVE_Success Then Begin
-                 WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,'Cannot set up DIVE blitter!',
-                               'DIVE Error!',0,MB_OK Or MB_ERROR Or MB_MOVEABLE);
-                End;
-               {DIVEBlitImage(DIVEHandle,DIVEImageBuffer,DIVE_Buffer_Screen);}
-
-               WinEndPaint(PS);
-              End;
-   Else ClientWindowProc:=WinDefWindowProc(Window,Msg,MP1,MP2);
- End;
-End;
-
-Procedure DIVEBlitThread;
-Begin
-End;
-
-Function LoadFiles : Boolean;
-Var RAWFile  : File;
-Begin
- LoadFiles:=False;
-
- Assign(RAWFile,'ANGEL.RAW'); { * Opening File * }
- Reset(RAWFile,1);
-
- If IOResult<>0 Then Exit; { * If File Not Found, Then Exit * }
-
- PicSize:=FileSize(RAWFile);
- GetMem(Picture,PicSize); { * Allocating Memory * }
- BlockRead(RAWFile,Picture^,PicSize); { * Loading File * }
-
- If IOResult<>0 Then Exit; { * If File Corrupted, Then Exit * }
-
- Close(RAWFile);
-
- LoadFiles:=True;
-End;
-
-Begin
- { * PM Init * }
- Anchor:=WinInitialize(0);
-
- { It might be beneficial to set the second parameter of the following }
- { call to something large, such as 1000.  The OS/2 documentation does }
- { not recommend this, however }
- MsgQue:=WinCreateMsgQueue(Anchor,0);
- If MsgQue=0 Then Halt(254);
-
- { * Loading Graphics File * }
- If Not LoadFiles Then Begin
-   WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,'File Corrupted : ANGEL.RAW',
-                 'File Loading Error!',0,MB_OK Or MB_ERROR Or MB_MOVEABLE);
-   WinDestroyMsgQueue(MsgQue);
-   WinTerminate(Anchor);
-  End;
-
- { * Opening DIVE, exiting if cannot be initialized * }
- If DIVEOpen(DIVEHandle,1,Framebuffer)<>DIVE_Success Then Begin
-   WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,'DIVE subsystem cannot be initialized!',
-                 'DIVE Error!',0,MB_OK Or MB_ERROR Or MB_MOVEABLE);
-   WinDestroyMsgQueue(MsgQue);
-   WinTerminate(Anchor);
-  End;
-
- WinRegisterClass(Anchor,ClassName,Proc(@ClientWindowProc),cs_SizeRedraw,SizeOf(Pointer));
- Frame:=WinCreateStdWindow(hwnd_Desktop,0,WinFlags,ClassName,'DIVE with FPC/2 Example',
-                           0,0,idClientWindow, Client);
-
- If (Frame<>0) Then Begin
-
-   {$ASMMODE INTEL}
-   Asm { * Tweakin' rules. :) Anyway, can i make something like this in pascal? (Eg. : DWordNum:='ABCD' ?) * }
-    MOV EAX,'3BGR'
-    MOV DIVEColorFormat,EAX
-   End;
-   If DIVEAllocImageBuffer(DIVEHandle,DIVEImageBuffer,DIVEColorFormat,640,480,0,Picture)<>DIVE_Success Then Begin
-     WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,'DIVE image buffer cannot be allocated!',
-                   'DIVE Error!',0,MB_OK Or MB_ERROR Or MB_MOVEABLE);
-     DIVEClose(DIVEHandle);
-     FreeMem(Picture,PicSize);
-     WinDestroyMsgQueue(MsgQue);
-     WinTerminate(Anchor);
-    End;
-
-   WinSetWindowPos(Frame,0,0,WinQuerySysValue(hwnd_Desktop,sv_CyScreen)-480,
-                   640,480,swp_Move+swp_Size+swp_Activate+swp_Show);
-   While WinGetMsg(Anchor,Message,0,0,0) Do WinDispatchMsg(Anchor,Message);
-
-   { * Closing DIVE * }
-   If DIVEFreeImageBuffer(DIVEHandle,DIVEImageBuffer)<>DIVE_Success Then Begin
-     WinMessageBox(HWND_DESKTOP,HWND_DESKTOP,'DIVE image buffer cannot be deallocated!',
-                   'DIVE Error!',0,MB_OK Or MB_ERROR Or MB_MOVEABLE);
-    End;
-   DIVEClose(DIVEHandle);
-
-   WinDestroyWindow(Frame);
-  End;
-
- { * Freeing Up Allocated Memory * }
- FreeMem(Picture,PicSize);
-
- { * PM Close * }
- WinDestroyMsgQueue(MsgQue);
- WinTerminate(Anchor);
-End.
-
-{
-  $Log$
-  Revision 1.2  2000-06-18 18:34:28  hajny
-   * necessary $I- added
-
-
-}