Positive Zahlen in negative umwandeln

[littleDave]

Hier ist nochwas mit MultiMedia: funktioniert zwar noch nicht ganz perfekt und es gibt einige Einschränkungen, aber immerhin kommt eine Negative Zahl raus (schwankung: +- 5) - aber immerhin ist sie negativ und Multimedia

Systemvorrausetzungen:
OpenGl 2.0 fähige Grafikkarte mit ShaderSupport

Erstellungsdauer: ca. 10 min

Benötige Units: dglOpenGl;

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dglOpenGL, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    FDC : HDC;
    FRC : THandle;
    FNumber : cardinal;
    FProgram : GLuint;

    FVertex   : string;
    FFragment : string;
    procedure DoRender;
  end;

var
  Form1: TForm1;

implementation

const
  SBadPC = 'Dein PC kann keine Zahlen negieren :P';

{$R *.dfm}

function CheckForErrors(glObject: GLHandleARB): String;
 var
  blen, slen: GLInt;
  InfoLog   : PGLCharARB;
begin
 glGetObjectParameterivARB(glObject, GL_OBJECT_INFO_LOG_LENGTH_ARB, @blen);
 if blen > 1 then
 begin
  GetMem(InfoLog, blen*SizeOf(GLCharARB));
  glGetInfoLogARB(glObject, blen , slen, InfoLog);
  Result:= PChar(InfoLog);
  Dispose(InfoLog);
 end;
end;  


function LoadFragmentandVertexShader(FShaderText: string; VShaderText: string): GLHandleARB;
var
  ProgramObject, FragmentShaderObject, VertexShaderObject: GLHandleARB;
  FShaderLength: Integer;
  VShaderLength: Integer;
begin
 ProgramObject:= glCreateProgramObjectARB;

 FragmentShaderObject:= glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
 VertexShaderObject:= glCreateShaderObjectARB(GL_VERTEX_SHADER_ARB);

 FShaderLength:= Length(FShaderText);

 VShaderLength:= Length(VShaderText);

 glShaderSourceARB(VertexShaderObject, 1, @VShaderText, @VShaderLength);
 glShaderSourceARB(FragmentShaderObject, 1, @FShaderText, @FShaderLength);

 glCompileShaderARB(FragmentShaderObject);
 glCompileShaderARB(VertexShaderObject);
 //ShowMessage(CheckForErrors(VertexShaderObject));
 
 glAttachObjectARB(ProgramObject, FragmentShaderObject);
 glAttachObjectARB(ProgramObject, VertexShaderObject);

 
 glDeleteObjectARB(FragmentShaderObject);
 glDeleteObjectARB(VertexShaderObject);
 glLinkProgramARB(ProgramObject);

 Result:= ProgramObject;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFragment :=
  'void main(void)'+#13#10+
  '{'+#13#10+
  ' vec4 aColor = gl_Color;'+#13#10+
  ' aColor.x = 1.0;'+#13#10+
  ' gl_FragColor = aColor;'+#13#10+
  '}'+#13#10;

  FVertex :=
  'void main(void)'+#13#10+
  '{'+#13#10+
  ' gl_Position = gl_ModelViewProjectionMatrix * gl_Vertex;'+#13#10+
  ' gl_FrontColor = gl_Color;'+#13#10+
  '}'+#13#10;



  if not InitOpenGL() then
     raise Exception.Create(SBadPC);

  FDC := GetDC(Handle);
  FRC := CreateRenderingContext(FDC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
  ActivateRenderingContext(FDC, FRC);


  if not GL_VERSION_2_0 then
     raise Exception.Create(SBadPC);

  if not GL_ARB_shading_language_100 then
     raise Exception.Create(SBadPC);

  FProgram := LoadFragmentandVertexShader(FFragment, FVertex);
  if FProgram = 0 then
     raise Exception.Create(SBadPC);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  DoRender;
end;

procedure TForm1.DoRender;
var aNumber : integer;
    bBool   : boolean;
begin
  glClearColor(0, 0, 0, 0);
  glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glViewPort(0, 0, ClientWidth, ClientHeight);
  gluPerspective(90, ClientWidth/ClientHeight, 1, 128);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glDisable(GL_TEXTURE_2D);
  glDisable(GL_LIGHTING);
  glDisable(GL_CULL_FACE);


  glTranslatef(0, 0, -1);
  //FNumber := (RGB(0, 126, 255) shl 8) or $FF;
  //FNumber := $00ABCDEF;
  Caption := IntToStr(FNumber and $FFFFFF);

  glColor4ubv(@FNumber);

  //Caption := IntToStr(glGetError);
  glUseProgramObjectARB(FProgram);
  //Caption := IntToStr(glGetError);
  //glColor4f(1, 1, 1, 1);
  glBegin(GL_QUADS);
    glVertex3f(-1, 1, 0);
    glVertex3f(-1,-1, 0);
    glVertex3f( 1,-1, 0);
    glVertex3f( 1, 1, 0);

  glEnd();

  aNumber := 0;
  glReadPixels(ClientWidth div 2, ClientHeight div 2, 1, 1, GL_RGBA, GL_UNSIGNED_BYTE, @aNumber);

  bBool    := aNumber and $FF000000 > 0;
  aNumber  := aNumber and $FFFFFF;
  if bBool then
     aNumber := -aNumber;

  Caption := Caption + ' ' + IntToStr(aNumber);

  glGetError;
  SwapBuffers(FDC)
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  FNumber := random($FFFFFF);
end;

end.