mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-24 16:28:53 -05:00
9d6c4ee850
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@58 3f818213-9676-44b0-a9b4-5e4c4e03d09d
219 lines
8.1 KiB
ObjectPascal
219 lines
8.1 KiB
ObjectPascal
|
|
unit uPSR_graphics;
|
|
{$I PascalScript.inc}
|
|
interface
|
|
uses
|
|
uPSRuntime, uPSUtils;
|
|
|
|
|
|
|
|
procedure RIRegisterTGRAPHICSOBJECT(Cl: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTFont(Cl: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTPEN(Cl: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTBRUSH(Cl: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTCanvas(cl: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTGraphic(CL: TPSRuntimeClassImporter);
|
|
procedure RIRegisterTBitmap(CL: TPSRuntimeClassImporter; Streams: Boolean);
|
|
|
|
procedure RIRegister_Graphics(Cl: TPSRuntimeClassImporter; Streams: Boolean);
|
|
|
|
implementation
|
|
{$IFNDEF FPC}
|
|
uses
|
|
Classes{$IFDEF CLX}, QGraphics{$ELSE}, Windows, Graphics{$ENDIF};
|
|
{$ELSE}
|
|
uses
|
|
Classes, Graphics,LCLType;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF CLX}
|
|
procedure TFontHandleR(Self: TFont; var T: Longint); begin T := Self.Handle; end;
|
|
procedure TFontHandleW(Self: TFont; T: Longint); begin Self.Handle := T; end;
|
|
{$ENDIF}
|
|
procedure TFontPixelsPerInchR(Self: TFont; var T: Longint); begin T := Self.PixelsPerInch; end;
|
|
procedure TFontPixelsPerInchW(Self: TFont; T: Longint); begin {$IFNDEF FPC} Self.PixelsPerInch := T;{$ENDIF} end;
|
|
procedure TFontStyleR(Self: TFont; var T: TFontStyles); begin T := Self.Style; end;
|
|
procedure TFontStyleW(Self: TFont; T: TFontStyles); begin Self.Style:= T; end;
|
|
|
|
procedure RIRegisterTFont(Cl: TPSRuntimeClassImporter);
|
|
begin
|
|
with Cl.Add(TFont) do
|
|
begin
|
|
RegisterConstructor(@TFont.Create, 'CREATE');
|
|
{$IFNDEF CLX}
|
|
RegisterPropertyHelper(@TFontHandleR, @TFontHandleW, 'HANDLE');
|
|
{$ENDIF}
|
|
RegisterPropertyHelper(@TFontPixelsPerInchR, @TFontPixelsPerInchW, 'PIXELSPERINCH');
|
|
RegisterPropertyHelper(@TFontStyleR, @TFontStyleW, 'STYLE');
|
|
end;
|
|
end;
|
|
{$IFNDEF CLX}
|
|
procedure TCanvasHandleR(Self: TCanvas; var T: Longint); begin T := Self.Handle; end;
|
|
procedure TCanvasHandleW(Self: TCanvas; T: Longint); begin Self.Handle:= T; end;
|
|
{$ENDIF}
|
|
|
|
procedure TCanvasPixelsR(Self: TCanvas; var T: Longint; X,Y: Longint); begin T := Self.Pixels[X,Y]; end;
|
|
procedure TCanvasPixelsW(Self: TCanvas; T, X, Y: Longint); begin Self.Pixels[X,Y]:= T; end;
|
|
|
|
procedure RIRegisterTCanvas(cl: TPSRuntimeClassImporter); // requires TPersistent
|
|
begin
|
|
with Cl.Add(TCanvas) do
|
|
begin
|
|
{$IFNDEF FPC}
|
|
RegisterMethod(@TCanvas.Arc, 'ARC');
|
|
RegisterMethod(@TCanvas.Chord, 'CHORD');
|
|
RegisterMethod(@TCanvas.Rectangle, 'RECTANGLE');
|
|
RegisterMethod(@TCanvas.RoundRect, 'ROUNDRECT');
|
|
RegisterMethod(@TCanvas.Ellipse, 'ELLIPSE');
|
|
RegisterMethod(@TCanvas.FillRect, 'FILLRECT');
|
|
{$ENDIF}
|
|
RegisterMethod(@TCanvas.Draw, 'DRAW');
|
|
{$IFNDEF CLX}
|
|
RegisterMethod(@TCanvas.FloodFill, 'FLOODFILL');
|
|
{$ENDIF}
|
|
RegisterMethod(@TCanvas.Lineto, 'LINETO');
|
|
RegisterMethod(@TCanvas.Moveto, 'MOVETO');
|
|
RegisterMethod(@TCanvas.Pie, 'PIE');
|
|
RegisterMethod(@TCanvas.Refresh, 'REFRESH');
|
|
RegisterMethod(@TCanvas.TextHeight, 'TEXTHEIGHT');
|
|
RegisterMethod(@TCanvas.TextOut, 'TEXTOUT');
|
|
RegisterMethod(@TCanvas.TextWidth, 'TEXTWIDTH');
|
|
{$IFNDEF CLX}
|
|
RegisterPropertyHelper(@TCanvasHandleR, @TCanvasHandleW, 'HANDLE');
|
|
{$ENDIF}
|
|
RegisterPropertyHelper(@TCanvasPixelsR, @TCanvasPixelsW, 'PIXELS');
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TGRAPHICSOBJECTONCHANGE_W(Self: TGraphicsObject; T: TNotifyEvent); begin Self.OnChange := t; end;
|
|
procedure TGRAPHICSOBJECTONCHANGE_R(Self: TGraphicsObject; var T: TNotifyEvent); begin T :=Self.OnChange; end;
|
|
|
|
|
|
procedure RIRegisterTGRAPHICSOBJECT(Cl: TPSRuntimeClassImporter);
|
|
begin
|
|
with Cl.Add(TGRAPHICSOBJECT) do
|
|
begin
|
|
RegisterPropertyHelper(@TGRAPHICSOBJECTONCHANGE_R, @TGRAPHICSOBJECTONCHANGE_W, 'ONCHANGE');
|
|
end;
|
|
end;
|
|
|
|
procedure RIRegisterTPEN(Cl: TPSRuntimeClassImporter);
|
|
begin
|
|
with Cl.Add(TPEN) do
|
|
begin
|
|
RegisterConstructor(@TPEN.CREATE, 'CREATE');
|
|
end;
|
|
end;
|
|
|
|
procedure RIRegisterTBRUSH(Cl: TPSRuntimeClassImporter);
|
|
begin
|
|
with Cl.Add(TBRUSH) do
|
|
begin
|
|
RegisterConstructor(@TBRUSH.CREATE, 'CREATE');
|
|
end;
|
|
end;
|
|
|
|
procedure TGraphicOnChange_W(Self: TGraphic; const T: TNotifyEvent); begin Self.OnChange := T; end;
|
|
procedure TGraphicOnChange_R(Self: TGraphic; var T: TNotifyEvent); begin T := Self.OnChange; end;
|
|
procedure TGraphicWidth_W(Self: TGraphic; const T: Integer); begin Self.Width := T; end;
|
|
procedure TGraphicWidth_R(Self: TGraphic; var T: Integer); begin T := Self.Width; end;
|
|
procedure TGraphicModified_W(Self: TGraphic; const T: Boolean); begin Self.Modified := T; end;
|
|
procedure TGraphicModified_R(Self: TGraphic; var T: Boolean); begin T := Self.Modified; end;
|
|
procedure TGraphicHeight_W(Self: TGraphic; const T: Integer); begin Self.Height := T; end;
|
|
procedure TGraphicHeight_R(Self: TGraphic; var T: Integer); begin T := Self.Height; end;
|
|
procedure TGraphicEmpty_R(Self: TGraphic; var T: Boolean); begin T := Self.Empty; end;
|
|
|
|
procedure RIRegisterTGraphic(CL: TPSRuntimeClassImporter);
|
|
begin
|
|
with CL.Add(TGraphic) do
|
|
begin
|
|
RegisterVirtualConstructor(@TGraphic.Create, 'Create');
|
|
RegisterVirtualMethod(@TGraphic.LoadFromFile, 'LoadFromFile');
|
|
RegisterVirtualMethod(@TGraphic.SaveToFile, 'SaveToFile');
|
|
RegisterPropertyHelper(@TGraphicEmpty_R,nil,'Empty');
|
|
RegisterPropertyHelper(@TGraphicHeight_R,@TGraphicHeight_W,'Height');
|
|
RegisterPropertyHelper(@TGraphicWidth_R,@TGraphicWidth_W,'Width');
|
|
RegisterPropertyHelper(@TGraphicOnChange_R,@TGraphicOnChange_W,'OnChange');
|
|
|
|
{$IFNDEF PS_MINIVCL}
|
|
RegisterPropertyHelper(@TGraphicModified_R,@TGraphicModified_W,'Modified');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TBitmapTransparentColor_R(Self: TBitmap; var T: TColor); begin T := Self.TransparentColor; end;
|
|
{$IFNDEF CLX}
|
|
{$IFNDEF FPC}
|
|
procedure TBitmapIgnorePalette_W(Self: TBitmap; const T: Boolean); begin Self.IgnorePalette := T; end;
|
|
procedure TBitmapIgnorePalette_R(Self: TBitmap; var T: Boolean); begin T := Self.IgnorePalette; end;
|
|
{$ENDIF}
|
|
procedure TBitmapPalette_W(Self: TBitmap; const T: HPALETTE); begin Self.Palette := T; end;
|
|
procedure TBitmapPalette_R(Self: TBitmap; var T: HPALETTE); begin T := Self.Palette; end;
|
|
{$ENDIF}
|
|
procedure TBitmapMonochrome_W(Self: TBitmap; const T: Boolean); begin Self.Monochrome := T; end;
|
|
procedure TBitmapMonochrome_R(Self: TBitmap; var T: Boolean); begin T := Self.Monochrome; end;
|
|
{$IFNDEF CLX}
|
|
procedure TBitmapHandle_W(Self: TBitmap; const T: HBITMAP); begin Self.Handle := T; end;
|
|
procedure TBitmapHandle_R(Self: TBitmap; var T: HBITMAP); begin T := Self.Handle; end;
|
|
{$ENDIF}
|
|
procedure TBitmapCanvas_R(Self: TBitmap; var T: TCanvas); begin T := Self.Canvas; end;
|
|
|
|
procedure RIRegisterTBitmap(CL: TPSRuntimeClassImporter; Streams: Boolean);
|
|
begin
|
|
with CL.Add(TBitmap) do
|
|
begin
|
|
if Streams then begin
|
|
RegisterMethod(@TBitmap.LoadFromStream, 'LoadFromStream');
|
|
RegisterMethod(@TBitmap.SaveToStream, 'SaveToStream');
|
|
end;
|
|
RegisterPropertyHelper(@TBitmapCanvas_R,nil,'Canvas');
|
|
{$IFNDEF CLX}
|
|
RegisterPropertyHelper(@TBitmapHandle_R,@TBitmapHandle_W,'Handle');
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF PS_MINIVCL}
|
|
{$IFNDEF FPC}
|
|
RegisterMethod(@TBitmap.Dormant, 'Dormant');
|
|
{$ENDIF}
|
|
RegisterMethod(@TBitmap.FreeImage, 'FreeImage');
|
|
{$IFNDEF CLX}
|
|
RegisterMethod(@TBitmap.LoadFromClipboardFormat, 'LoadFromClipboardFormat');
|
|
{$ENDIF}
|
|
RegisterMethod(@TBitmap.LoadFromResourceName, 'LoadFromResourceName');
|
|
RegisterMethod(@TBitmap.LoadFromResourceID, 'LoadFromResourceID');
|
|
{$IFNDEF CLX}
|
|
RegisterMethod(@TBitmap.ReleaseHandle, 'ReleaseHandle');
|
|
RegisterMethod(@TBitmap.ReleasePalette, 'ReleasePalette');
|
|
RegisterMethod(@TBitmap.SaveToClipboardFormat, 'SaveToClipboardFormat');
|
|
RegisterPropertyHelper(@TBitmapMonochrome_R,@TBitmapMonochrome_W,'Monochrome');
|
|
RegisterPropertyHelper(@TBitmapPalette_R,@TBitmapPalette_W,'Palette');
|
|
{$IFNDEF FPC}
|
|
RegisterPropertyHelper(@TBitmapIgnorePalette_R,@TBitmapIgnorePalette_W,'IgnorePalette');
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
RegisterPropertyHelper(@TBitmapTransparentColor_R,nil,'TransparentColor');
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure RIRegister_Graphics(Cl: TPSRuntimeClassImporter; Streams: Boolean);
|
|
begin
|
|
RIRegisterTGRAPHICSOBJECT(cl);
|
|
RIRegisterTFont(Cl);
|
|
RIRegisterTCanvas(cl);
|
|
RIRegisterTPEN(cl);
|
|
RIRegisterTBRUSH(cl);
|
|
RIRegisterTGraphic(CL);
|
|
RIRegisterTBitmap(CL, Streams);
|
|
end;
|
|
|
|
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
|
|
|
|
end.
|
|
|
|
|
|
|
|
|
|
|