1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 16:28:53 -05:00
Simba/Units/RUTIS/Rutis_EXT_Canvas.pas

430 lines
13 KiB
ObjectPascal
Raw Normal View History

2010-08-20 11:21:43 -04:00
Unit Rutis_EXT_Canvas;
Interface
Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ComCtrls, ExtCtrls,
Rutis_Stack, Rutis_Engine, Rutis_Defs;
Type
TUniversalCanvas = Class(TControlCanvas)
Protected
fDCHandle : HWND;
Public
Destructor Destroy; Override;
Procedure ReleaseTarget;
Procedure SetTargetDC(DC : HDC);
Procedure SetTargetHandle(AHandle : HWND);
Procedure SetTargetControl(AControl : TControl);
End;
Var
RC_Buffer : TBitmap;
RC_DrawCanvas : TCanvas;
RC_TargetCanvas : TCanvas;
RC_DoubleBuffered : Boolean;
RC_Width,
RC_Height : Integer;
RC_BGColor : TColor;
Procedure RC_SetTargetDC(DC : HDC);
Procedure RC_SetTargetHandle(Handle : HWND);
Procedure RC_SetTargetCanvas(Canvas : TCanvas);
Procedure RC_SetTargetControl(Control : TControl);
Procedure RC_Repaint;
Procedure RegisterEXTMethods(Engine : TRutisEngine);
Implementation
Var
RC_DCCanvas : TUniversalCanvas;
Type
PControl = ^TControl;
//==============================================================================
//==============================================================================
{ TUniversalCanvas }
Destructor TUniversalCanvas.Destroy;
Begin
ReleaseTarget;
Inherited;
End;
Procedure TUniversalCanvas.ReleaseTarget;
Begin
If HandleAllocated Then
Begin
If (fDCHandle <> 0) Then
ReleaseDC(Handle, fDCHandle);
Handle := 0;
fDCHandle := 0;
End;
End;
Procedure TUniversalCanvas.SetTargetDC(DC : HDC);
Begin
ReleaseTarget;
If DC = 0 Then exit;
Handle := DC;
End;
Procedure TUniversalCanvas.SetTargetHandle(AHandle : HWND);
Begin
ReleaseTarget;
//If AHandle = 0 then exit;
fDCHandle := AHandle;
Try
Handle := GetDC(fDCHandle);
Except
Handle := 0;
fDCHandle := 0;
End;
End;
Procedure TUniversalCanvas.SetTargetControl(AControl : TControl);
Begin
ReleaseTarget;
If AControl <> nil Then
Control := AControl;
End;
//==============================================================================
//==============================================================================
Procedure RC_SetTargetDC(DC : HDC);
Begin
RC_DCCanvas.SetTargetDC(DC);
RC_TargetCanvas := RC_DCCanvas;
If RC_DoubleBuffered Then
RC_DrawCanvas := RC_Buffer.Canvas
Else
RC_DrawCanvas := RC_TargetCanvas;
End;
Procedure RC_SetTargetHandle(Handle : HWND);
Begin
RC_DCCanvas.SetTargetHandle(Handle);
RC_TargetCanvas := RC_DCCanvas;
If RC_DoubleBuffered Then
RC_DrawCanvas := RC_Buffer.Canvas
Else
RC_DrawCanvas := RC_TargetCanvas;
End;
Procedure RC_SetTargetControl(Control : TControl);
Begin
If (Control is TImage) Then
Begin
RC_TargetCanvas := TImage(Control).Canvas;
RC_DCCanvas.ReleaseTarget;
End
Else
Begin
RC_DCCanvas.SetTargetControl(Control);
RC_TargetCanvas := RC_DCCanvas;
End;
If RC_DoubleBuffered Then
RC_DrawCanvas := RC_Buffer.Canvas
Else
RC_DrawCanvas := RC_TargetCanvas;
End;
Procedure RC_SetTargetCanvas(Canvas : TCanvas);
Begin
RC_DCCanvas.ReleaseTarget;
RC_TargetCanvas := Canvas;
If RC_DoubleBuffered Then
RC_DrawCanvas := RC_Buffer.Canvas
Else
RC_DrawCanvas := RC_TargetCanvas;
End;
Procedure RC_Repaint;
Begin
If RC_DoubleBuffered Then
RC_TargetCanvas.Draw(0, 0, RC_Buffer);
End;
//==============================================================================
//==============================================================================
Procedure _CanvasDC(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_SetTargetDC(PCardinal(Params^[0].Data)^);
End;
Procedure _CanvasHandle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_SetTargetHandle(PCardinal(Params^[0].Data)^);
End;
Procedure _CanvasControl(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_SetTargetControl(PControl(Params^[0].Data)^);
End;
Procedure _CanvasDoubleBuffered(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DoubleBuffered := PBoolean(Params^[0].Data)^;
If RC_DoubleBuffered Then
RC_DrawCanvas := RC_Buffer.Canvas
Else
RC_DrawCanvas := RC_TargetCanvas;
End;
Procedure _CanvasClear(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var
rect : TRect;
TmpColor : TColor;
Begin
// RC_BGColor := RC_DrawCanvas.Brush.Color;
// If RC_DoubleBuffered Then
// Begin
// //RC_Buffer.Width := 0;
// //RC_Buffer.Width := RC_Width;
// rect := RC_Buffer.Canvas.ClipRect;
// inc(rect.Right);
// inc(rect.Bottom);
// TmpColor := RC_Buffer.Canvas.Pen.Color;
// RC_Buffer.Canvas.Pen.Color := RC_BGColor;
// RC_Buffer.Canvas.FillRect(rect);
// RC_Buffer.Canvas.Pen.Color := TmpColor;
// End
// Else
// Begin
// rect := RC_TargetCanvas.ClipRect;
// inc(rect.Right);
// inc(rect.Bottom);
// RC_TargetCanvas.Brush.Color := RC_BGColor;
// RC_TargetCanvas.Pen.Color := RC_BGColor;
// RC_TargetCanvas.FillRect(rect);
// End;
RC_BGColor := RC_DrawCanvas.Brush.Color;
TmpColor := RC_DrawCanvas.Pen.Color;
rect := RC_DrawCanvas.ClipRect;
Inc(rect.Right);
Inc(rect.Bottom);
RC_DrawCanvas.Pen.Color := RC_BGColor;
RC_DrawCanvas.FillRect(rect);
RC_DrawCanvas.Pen.Color := TmpColor;
End;
Procedure _CanvasSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var
AColor : TColor;
Begin
RC_Width := PInteger(Params^[0].Data)^;
RC_Height := PInteger(Params^[1].Data)^;
//CorrectBufferSize(RC_Width, RC_Height);
If RC_DoubleBuffered Then
With RC_Buffer Do
Begin
AColor := Canvas.Brush.Color;
Canvas.Brush.Color := RC_BGColor;
If (RC_Width <> Width) Then Width := RC_Width;
If (RC_Height <> Height) Then Height := RC_Height;
Canvas.Brush.Color := AColor;
End;
End;
Procedure _CanvasDisplay(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
If RC_DoubleBuffered Then
RC_TargetCanvas.Draw(0, 0, RC_Buffer);
End;
//==============================================================================
Procedure _BrushSolid(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Brush.Style := bsSolid;
End;
Procedure _BrushClear(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Brush.Style := bsClear;
End;
Procedure _PenColor(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Pen.Color := PColor(Params^[0].Data)^;
End;
Procedure _BrushColor(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Brush.Color := PColor(Params^[0].Data)^;
End;
Procedure _PenColorRGB(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Pen.Color := rgb(PByte(Params^[0].Data)^, PByte(Params^[1].Data)^, PByte(Params^[2].Data)^);
End;
Procedure _BrushColorRGB(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Brush.Color := rgb(PByte(Params^[0].Data)^, PByte(Params^[1].Data)^, PByte(Params^[2].Data)^);
End;
Procedure _PenWidth(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Pen.Width := PInteger(Params^[0].Data)^;
End;
Procedure _Rectangle(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var x1, y1, x2, y2 : Integer;
Begin
x1 := PInteger(Params^[0].Data)^;
y1 := PInteger(Params^[1].Data)^;
x2 := PInteger(Params^[2].Data)^;
y2 := PInteger(Params^[3].Data)^;
//CorrectBufferSize(Max(x1, x2), Max(y1, y2));
RC_DrawCanvas.Rectangle(x1, y1, x2, y2);
End;
Procedure _Ellipse(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var x1, y1, x2, y2 : Integer;
Begin
x1 := PInteger(Params^[0].Data)^;
y1 := PInteger(Params^[1].Data)^;
x2 := PInteger(Params^[2].Data)^;
y2 := PInteger(Params^[3].Data)^;
//CorrectBufferSize(Max(x1, x2), Max(y1, y2));
RC_DrawCanvas.Ellipse(x1, y1, x2, y2);
End;
Procedure _MoveTo(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var x1, y1 : Integer;
Begin
x1 := PInteger(Params^[0].Data)^;
y1 := PInteger(Params^[1].Data)^;
//CorrectBufferSize(x1,y1);
RC_DrawCanvas.MoveTo(x1, y1);
End;
Procedure _LineTo(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var x1, y1 : Integer;
Begin
x1 := PInteger(Params^[0].Data)^;
y1 := PInteger(Params^[1].Data)^;
//CorrectBufferSize(x1,y1);
RC_DrawCanvas.LineTo(x1, y1);
End;
Procedure _TextOut(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Var x1, y1 : Integer;
Begin
x1 := PInteger(Params^[0].Data)^;
y1 := PInteger(Params^[1].Data)^;
With RC_DrawCanvas Do
Begin
//CorrectBufferSize(x1 + TextHeight(Params^[2]), y1 + TextWidth(Params^[2]));
RC_DrawCanvas.Font.Color := RC_DrawCanvas.Pen.Color;
TextOut(x1, y1, PAnsiString(Params^[2].Data)^);
End;
End;
Procedure _TextSize(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Font.Size := GetPInteger(Params^[0].Data);
End;
Procedure _GetPixel(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
PCardinal(Result^.Data)^ := Cardinal(RC_DrawCanvas.Pixels[PInteger(Params^[0].Data)^,
PInteger(Params^[1].Data)^]);
End;
Procedure _SetPixel(Params : PRutisParamInfoArray; Result : PRutisParamInfo);
Begin
RC_DrawCanvas.Pixels[PInteger(Params^[0].Data)^,
PInteger(Params^[1].Data)^] := TColor(PCardinal(Params^[2].Data)^);
End;
//==============================================================================
//==============================================================================
Procedure RegisterEXTMethods(Engine : TRutisEngine);
Begin
OutputDebugString(PChar('Rutis_EXT_Canvas.RegisterEXTMethods - Registering RUTIS Canvas Support'));
//==============================================================================
//====================== CANVAS ================================================
//==============================================================================
Engine.RegExtMethod('CanvasControl',{$IfDef FPC}@{$EndIf}_CanvasControl, ['TControl'], '',
'Set the Control for the Canvas');
Engine.RegExtMethod('CanvasHandle',{$IfDef FPC}@{$EndIf}_CanvasHandle, ['HWND'], '',
'Set the Handle for the Canvas' + sLineBreak +
'The needed Device Context will be retrived automatically');
Engine.RegExtMethod('CanvasDC',{$IfDef FPC}@{$EndIf}_CanvasDC, ['HDC'], '',
'Set the DeviceContext for the Canvas' + sLineBreak +
'You need to get the DC with GetDC first' + sLineBreak +
'CanvasDC should normally not be used - use CanvasHandle instead');
Engine.RegExtMethod('CanvasSize',{$IfDef FPC}@{$EndIf}_CanvasSize, ['Integer', 'Integer'], '',
'Set up the Buffer-Size' + sLineBreak +
'Only needed when using DoubleBuffered-ON');
Engine.RegExtMethod('CanvasDisplay',{$IfDef FPC}@{$EndIf}_CanvasDisplay, [], '',
'Displays the Buffer' + sLineBreak +
'Only needed when using DoubleBuffered-ON');
Engine.RegExtMethod('CanvasClear',{$IfDef FPC}@{$EndIf}_CanvasClear, [], '',
'Clears the painted content');
Engine.RegExtMethod('CanvasDoubleBuffered',{$IfDef FPC}@{$EndIf}_CanvasDoubleBuffered, ['Boolean'], '',
'If set, all content will be painted into a separate Buffer' + sLineBreak +
'You will need to set up the Buffer with CanvasSize and CanvasClear first and' + sLineBreak +
'you have to call CanvasDisplay to show the painted content');
Engine.RegExtMethod('MoveTo',{$IfDef FPC}@{$EndIf}_Moveto, ['Integer', 'Integer'], '');
Engine.RegExtMethod('LineTo',{$IfDef FPC}@{$EndIf}_Lineto, ['Integer', 'Integer'], '');
Engine.RegExtMethod('Rectangle',{$IfDef FPC}@{$EndIf}_Rectangle, ['Integer', 'Integer', 'Integer', 'Integer'], '');
Engine.RegExtMethod('Ellipse',{$IfDef FPC}@{$EndIf}_Ellipse, ['Integer', 'Integer', 'Integer', 'Integer'], '');
Engine.RegExtMethod('TextOut',{$IfDef FPC}@{$EndIf}_TextOut, ['Integer', 'Integer', 'String'], '');
Engine.RegExtMethod('TextSize',{$IfDef FPC}@{$EndIf}_TextSize, ['Integer'], '');
Engine.RegExtMethod('PenColorRGB',{$IfDef FPC}@{$EndIf}_PenColorRGB, ['Byte', 'Byte', 'Byte'], '');
Engine.RegExtMethod('BrushColorRGB',{$IfDef FPC}@{$EndIf}_BrushColorRGB, ['Byte', 'Byte', 'Byte'], '');
Engine.RegExtMethod('PenColor',{$IfDef FPC}@{$EndIf}_PenColor, ['Integer'], '');
Engine.RegExtMethod('BrushColor',{$IfDef FPC}@{$EndIf}_BrushColor, ['Integer'], '');
Engine.RegExtMethod('BrushSolid',{$IfDef FPC}@{$EndIf}_BrushSolid, [], '');
Engine.RegExtMethod('BrushClear',{$IfDef FPC}@{$EndIf}_BrushClear, [], '');
Engine.RegExtMethod('PenWidth',{$IfDef FPC}@{$EndIf}_PenWidth, ['Integer'], '');
Engine.RegExtMethod('GetPixel',{$IfDef FPC}@{$EndIf}_GetPixel, ['Integer', 'Integer'], 'Integer');
Engine.RegExtMethod('SetPixel',{$IfDef FPC}@{$EndIf}_SetPixel, ['Integer', 'Integer', 'Integer'], '');
OutputDebugString(PChar('Rutis_EXT_Canvas.RegisterEXTMethods - Successfully registered RUTIS Canvas Support'));
End;
//==============================================================================
//==============================================================================
Initialization
RC_Buffer := TBitmap.Create;
RC_DCCanvas := TUniversalCanvas.Create;
RC_DoubleBuffered := True;
RC_TargetCanvas := RC_Buffer.Canvas;
Finalization
RC_DCCanvas.Free;
RC_Buffer.Free;
End.