├── .gitignore ├── AsciiImage.RenderContext.FM.pas ├── AsciiImage.RenderContext.Factory.pas ├── AsciiImage.RenderContext.GDI.pas ├── AsciiImage.RenderContext.Intf.pas ├── AsciiImage.RenderContext.Types.pas ├── AsciiImage.RenderContext.pas ├── AsciiImage.Shapes.pas ├── AsciiImage.pas ├── Delphinus.Info.json ├── Delphinus.Install.json ├── Demo ├── Debug │ └── Win32 │ │ ├── Test.aig │ │ ├── fixture10.txt │ │ └── fixture6.txt ├── Demo.dpr ├── Demo.dproj ├── Main.dfm └── Main.pas ├── FMDemo ├── FMDemo.dpr ├── FMDemo.dproj ├── Main.fmx └── Main.pas ├── License ├── Logo.jpg ├── Packages ├── AsciiImageDesign.rc ├── DelphiXE │ ├── AsciiImageDesign.dpk │ └── AsciiImageDesign.dproj └── DelphiXE6 │ ├── AsciiImageDesign.dpk │ └── AsciiImageDesign.dproj └── ReadMe.txt /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | 25 | # Delphi compiler-generated binaries (safe to delete) 26 | *.exe 27 | *.dll 28 | *.bpl 29 | *.bpi 30 | *.dcp 31 | *.so 32 | *.apk 33 | *.drc 34 | *.map 35 | *.dres 36 | *.rsm 37 | *.tds 38 | *.dcu 39 | *.lib 40 | 41 | # Delphi autogenerated files (duplicated info) 42 | *.cfg 43 | *Resource.rc 44 | 45 | # Delphi local files (user-specific info) 46 | *.local 47 | *.identcache 48 | *.projdata 49 | *.tvsconfig 50 | *.dsk 51 | 52 | # Delphi history and backups 53 | __history/ 54 | *.~* 55 | 56 | # Castalia statistics file 57 | *.stat 58 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.FM.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext.FM; 2 | 3 | interface 4 | 5 | uses 6 | FMX.Graphics, 7 | System.Math.Vectors, 8 | AsciiImage.RenderContext.Types, 9 | AsciiImage.RenderContext; 10 | 11 | type 12 | TFMRenderContext = class(TRenderContext) 13 | private 14 | FCanvas: TCanvas; 15 | protected 16 | procedure BrushChanged; override; 17 | procedure PenChanged; override; 18 | public 19 | constructor Create(ACanvas: TCanvas); 20 | procedure Clear(AColor: TColorValue); override; 21 | procedure DrawEllipsis(const ARect: TRectF); override; 22 | procedure DrawLine(const AFrom: TPointF; const ATo: TPointF); override; 23 | procedure DrawPolygon(const APoints: array of TPointF); override; 24 | procedure FillRectangle(const ARect: TRectF); override; 25 | procedure BeginScene(const ARect: TRect); override; 26 | procedure EndScene(); override; 27 | end; 28 | 29 | implementation 30 | 31 | { TFMRenderContext } 32 | 33 | procedure TFMRenderContext.BeginScene; 34 | var 35 | LMoveMatrix: TMatrix; 36 | begin 37 | inherited; 38 | FCanvas.BeginScene(); 39 | LMoveMatrix := TMatrix.CreateTranslation(ARect.Left, ARect.Top); 40 | FCanvas.SetMatrix(FCanvas.Matrix * LMoveMatrix); 41 | end; 42 | 43 | procedure TFMRenderContext.BrushChanged; 44 | begin 45 | inherited; 46 | FCanvas.Fill.Color := Brush.Color; 47 | if Brush.Visible then 48 | FCanvas.Fill.Kind := TBrushKind.Solid 49 | else 50 | FCanvas.Fill.Kind := TbrushKind.None; 51 | end; 52 | 53 | procedure TFMRenderContext.Clear(AColor: TColorValue); 54 | begin 55 | inherited; 56 | FCanvas.Clear(AColor); 57 | end; 58 | 59 | constructor TFMRenderContext.Create(ACanvas: TCanvas); 60 | begin 61 | inherited Create(); 62 | FCanvas := ACanvas; 63 | end; 64 | 65 | procedure TFMRenderContext.DrawEllipsis(const ARect: TRectF); 66 | begin 67 | inherited; 68 | FCanvas.FillEllipse(ARect, 1); 69 | FCanvas.DrawEllipse(ARect, 1); 70 | end; 71 | 72 | procedure TFMRenderContext.DrawLine(const AFrom, ATo: TPointF); 73 | begin 74 | inherited; 75 | FCanvas.DrawLine(AFrom, ATo, 1); 76 | end; 77 | 78 | procedure TFMRenderContext.DrawPolygon(const APoints: array of TPointF); 79 | var 80 | LPolygon: TPolygon; 81 | i: Integer; 82 | begin 83 | inherited; 84 | SetLength(LPolygon, Length(APoints) + 1); 85 | for i := 0 to Length(APoints) - 1 do 86 | begin 87 | LPolygon[i] := APoints[i]; 88 | end; 89 | LPolygon[High(LPolygon)] := LPolygon[0]; 90 | FCanvas.FillPolygon(LPolygon, 1); 91 | FCanvas.DrawPolygon(LPolygon, 1); 92 | end; 93 | 94 | procedure TFMRenderContext.EndScene; 95 | begin 96 | inherited; 97 | FCanvas.EndScene(); 98 | end; 99 | 100 | procedure TFMRenderContext.FillRectangle(const ARect: TRectF); 101 | begin 102 | inherited; 103 | FCanvas.FillRect(ARect, 1, 1, [], 1); 104 | end; 105 | 106 | procedure TFMRenderContext.PenChanged; 107 | begin 108 | inherited; 109 | FCanvas.Stroke.Color := Pen.Color; 110 | FCanvas.Stroke.Thickness := Pen.Size; 111 | if Pen.Visible then 112 | FCanvas.Stroke.Kind := TBrushKind.Solid 113 | else 114 | FCanvas.Stroke.Kind := TBrushKind.None; 115 | end; 116 | 117 | end. 118 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.Factory.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext.Factory; 2 | 3 | interface 4 | 5 | uses 6 | Graphics, 7 | AsciiImage.RenderContext.Intf; 8 | 9 | type 10 | TCreateRenderContextHook = reference to function(ACanvas: TCanvas; AWidth, AHeight: Single): IRenderContext; 11 | 12 | TRenderContextFactory = class 13 | private 14 | class var FHook: TCreateRenderContextHook; 15 | public 16 | class function CreateDefaultRenderContext(ACanvas: TCanvas; AWidth, AHeight: Single): IRenderContext; 17 | class procedure SetHookCreateDefaultRenderContext(const AHook: TCreateRenderContextHook); 18 | end; 19 | 20 | implementation 21 | 22 | uses 23 | AsciiImage.RenderContext.Types, 24 | {$if Framework = 'VCL'} 25 | AsciiImage.RenderContext.GDI; 26 | {$Else} 27 | AsciiImage.RenderContext.FM; 28 | {$IfEnd} 29 | 30 | { TRenderContextFactory } 31 | 32 | class function TRenderContextFactory.CreateDefaultRenderContext( 33 | ACanvas: TCanvas; AWidth, AHeight: Single): IRenderContext; 34 | begin 35 | if Assigned(FHook) then 36 | begin 37 | Result := FHook(ACanvas, AWidth, AHeight); 38 | end 39 | else 40 | begin 41 | {$if Framework = 'VCL'} 42 | Result := TGDIRenderContext.Create(ACanvas, AWidth, AHeight); 43 | {$Else} 44 | Result := TFMRenderContext.Create(ACanvas); 45 | {$IfEnd} 46 | end; 47 | end; 48 | 49 | class procedure TRenderContextFactory.SetHookCreateDefaultRenderContext( 50 | const AHook: TCreateRenderContextHook); 51 | begin 52 | FHook := AHook; 53 | end; 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.GDI.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext.GDI; 2 | 3 | interface 4 | 5 | uses 6 | Types, 7 | Windows, 8 | Graphics, 9 | AsciiImage.RenderContext, 10 | AsciiImage.RenderContext.Types; 11 | 12 | type 13 | TDownSampling = (dsNone, dsX2, dsX4, dsX8); 14 | 15 | TGDIRenderContext = class(TRenderContext) 16 | private 17 | FTargetCanvas: TCanvas; 18 | FCanvas: TCanvas; 19 | FWidth: Single; 20 | FHeight: Single; 21 | FScale: Integer; 22 | FDownSampling: TDownSampling; 23 | FTemp: TBitmap; 24 | FTargetRect: TRect; 25 | procedure SetDownSampling(const Value: TDownSampling); 26 | class var FDefaultDownSampling: TDownSampling; 27 | protected 28 | procedure BrushChanged; override; 29 | procedure PenChanged; override; 30 | function GetDownSamplingScale(): Integer; 31 | public 32 | class constructor Create(); 33 | class procedure SetDefaultDownSampling(const ADownSampling: TDownSampling); 34 | class function GetDefaultDownSampling: TDownSampling; 35 | constructor Create(ACanvas: TCanvas; AWidth, AHeight: Single); 36 | destructor Destroy(); override; 37 | procedure Clear(AColor: TColorValue); override; 38 | procedure DrawEllipsis(const ARect: TRectF); override; 39 | procedure DrawLine(const AFrom: TPointF; const ATo: TPointF); override; 40 | procedure DrawPolygon(const APoints: array of TPointF); override; 41 | procedure FillRectangle(const ARect: TRectF); override; 42 | procedure BeginScene(const ARect: TRect); override; 43 | procedure EndScene(); override; 44 | property DownSampling: TDownSampling read FDownSampling write SetDownSampling; 45 | end; 46 | 47 | implementation 48 | 49 | uses 50 | Math; 51 | 52 | { TGDIRenderContext } 53 | 54 | procedure TGDIRenderContext.BeginScene; 55 | begin 56 | inherited; 57 | FScale := GetDownSamplingScale(); 58 | FTemp.SetSize(Round(FWidth*FScale), Round(FHeight*FScale)); 59 | FTargetRect := ARect; 60 | end; 61 | 62 | procedure TGDIRenderContext.BrushChanged; 63 | begin 64 | inherited; 65 | FCanvas.Brush.Color := Brush.Color; 66 | if Brush.Visible then 67 | FCanvas.Brush.Style := bsSolid 68 | else 69 | FCanvas.Brush.Style := bsClear; 70 | end; 71 | 72 | procedure TGDIRenderContext.Clear(AColor: TColorValue); 73 | begin 74 | FCanvas.Brush.Color := AColor; 75 | FCanvas.FillRect(FCanvas.ClipRect); 76 | FCanvas.Brush.Color := Brush.Color; 77 | end; 78 | 79 | class constructor TGDIRenderContext.Create; 80 | begin 81 | FDefaultDownSampling := dsX8; 82 | end; 83 | 84 | constructor TGDIRenderContext.Create(ACanvas: TCanvas; AWidth, AHeight: Single); 85 | begin 86 | inherited Create(); 87 | FTargetCanvas := ACanvas; 88 | FTemp := TBitmap.Create(); 89 | FCanvas := FTemp.Canvas; 90 | FWidth := AWidth; 91 | FHeight := AHeight; 92 | FDownSampling := FDefaultDownSampling; 93 | BrushChanged(); 94 | PenChanged(); 95 | end; 96 | 97 | destructor TGDIRenderContext.Destroy; 98 | begin 99 | FTemp.Free; 100 | inherited; 101 | end; 102 | 103 | procedure TGDIRenderContext.DrawEllipsis(const ARect: TRectF); 104 | begin 105 | FCanvas.Ellipse(Trunc(ARect.Left*FScale), Trunc(ARect.Top*FScale), Round(ARect.Right*FScale), Round(ARect.Bottom*FScale)); 106 | end; 107 | 108 | procedure TGDIRenderContext.DrawLine(const AFrom, ATo: TPointF); 109 | begin 110 | //draw forward and backwards, otherwhise when drawing in low resolutions, first pixel might not be colored 111 | FCanvas.MoveTo(Trunc(AFrom.X*FScale), Trunc(AFrom.Y*FScale)); 112 | FCanvas.LineTo(Trunc(ATo.X*FScale), Trunc(ATo.Y*FScale)); 113 | FCanvas.LineTo(Trunc(AFrom.X*FScale), Trunc(AFrom.Y*FScale)); 114 | end; 115 | 116 | procedure TGDIRenderContext.DrawPolygon(const APoints: array of TPointF); 117 | var 118 | LPoints: array of TPoint; 119 | i: Integer; 120 | begin 121 | SetLength(LPoints, Length(APoints)); 122 | for i := 0 to Length(APoints) - 1 do 123 | begin 124 | LPoints[i] := Point(Trunc(APoints[i].X*FScale), Trunc(APoints[i].Y*FScale)); 125 | end; 126 | FCanvas.Polygon(LPoints); 127 | end; 128 | 129 | procedure TGDIRenderContext.EndScene; 130 | var 131 | LOldMode: Cardinal; 132 | begin 133 | inherited; 134 | LOldMode := GetStretchBltMode(FTargetCanvas.Handle); 135 | SetStretchBltMode(FTargetCanvas.Handle, HALFTONE); 136 | StretchBlt(FTargetCanvas.Handle, FTargetRect.Left, FTargetRect.Top, FTargetRect.Right - FTargetRect.Left, FTargetRect.Bottom - FTargetRect.Top, 137 | FTemp.Canvas.Handle, 0, 0, FTemp.Width, FTemp.Height, SRCCOPY); 138 | SetStretchBltMode(FTargetCanvas.Handle, LOldMode); 139 | end; 140 | 141 | procedure TGDIRenderContext.FillRectangle(const ARect: TRectF); 142 | var 143 | LRect: TRect; 144 | begin 145 | LRect := Rect(Trunc(ARect.Left*FScale), Trunc(ARect.Top*FScale), Round(ARect.Right*FScale), Round(ARect.Bottom*FSCale)); 146 | FCanvas.FillRect(LRect); 147 | end; 148 | 149 | class function TGDIRenderContext.GetDefaultDownSampling: TDownSampling; 150 | begin 151 | Result := FDefaultDownSampling; 152 | end; 153 | 154 | function TGDIRenderContext.GetDownSamplingScale: Integer; 155 | begin 156 | case FDownSampling of 157 | dsX2: Result := 2; 158 | dsX4: Result := 4; 159 | dsX8: Result := 8; 160 | else 161 | Result := 1; 162 | end; 163 | end; 164 | 165 | procedure TGDIRenderContext.PenChanged; 166 | begin 167 | inherited; 168 | FCanvas.Pen.Color := Pen.Color; 169 | FCanvas.Pen.Width := Pen.Size * GetDownSamplingScale(); 170 | if Pen.Visible then 171 | FCanvas.Pen.Style := psSolid 172 | else 173 | FCanvas.Pen.Style := psClear; 174 | end; 175 | 176 | class procedure TGDIRenderContext.SetDefaultDownSampling( 177 | const ADownSampling: TDownSampling); 178 | begin 179 | FDefaultDownSampling := ADownSampling; 180 | end; 181 | 182 | procedure TGDIRenderContext.SetDownSampling(const Value: TDownSampling); 183 | begin 184 | if FDownSampling <> Value then 185 | begin 186 | FDownSampling := Value; 187 | PenChanged(); 188 | end; 189 | end; 190 | 191 | end. 192 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.Intf.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext.Intf; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Types, 8 | Graphics, 9 | AsciiImage.RenderContext.Types; 10 | 11 | type 12 | IProperties = interface; 13 | 14 | TPropertyChangedEvent = reference to procedure; 15 | 16 | IProperties = interface 17 | ['{171649BE-47FC-4536-822A-CCDD20878573}'] 18 | function GetOnChanged: TPropertyChangedEvent; 19 | procedure SetOnChanged(const Value: TPropertyChangedEvent); 20 | property OnChanged: TPropertyChangedEvent read GetOnChanged write SetOnChanged; 21 | end; 22 | 23 | IBrushProperties = interface(IProperties) 24 | ['{C716DFFA-B2CD-4210-981B-627B8F923D70}'] 25 | function GetColor: TColorValue; 26 | procedure SetColor(const Value: TColorValue); 27 | function GetVisible: Boolean; 28 | procedure SetVisible(const Value: Boolean); 29 | property Color: TColorValue read GetColor write SetColor; 30 | property Visible: Boolean read GetVisible write SetVisible; 31 | end; 32 | 33 | IPenProperties = interface(IBrushProperties) 34 | ['{DE04B09C-7ED5-4189-82A6-2C90F5E1F4D6}'] 35 | function GetSize: Integer; 36 | procedure SetSize(const Value: Integer); 37 | property Size: Integer read GetSize write SetSize; 38 | end; 39 | 40 | IRenderContext = interface 41 | ['{22DAA33A-F062-4F21-92EE-C38F09E2520B}'] 42 | function GetBrush: IBrushProperties; 43 | function GetPen: IPenProperties; 44 | procedure Clear(AColor: TColorValue); 45 | procedure DrawPolygon(const APoints: array of TPointF); 46 | procedure DrawLine(const AFrom, ATo: TPointF); 47 | procedure DrawEllipsis(const ARect: TRectF); 48 | procedure FillRectangle(const ARect: TRectF); 49 | procedure BeginScene(const ARect: TRect); 50 | procedure EndScene(); 51 | property Brush: IBrushProperties read GetBrush; 52 | property Pen: IPenProperties read GetPen; 53 | end; 54 | 55 | implementation 56 | 57 | end. 58 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.Types.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext.Types; 2 | 3 | interface 4 | 5 | uses 6 | Graphics, 7 | {$if CompilerVersion > 22} 8 | System.Types, 9 | System.UITypes; 10 | {$Else} 11 | Types; 12 | {$IfEnd} 13 | 14 | {$If declared(TGraphic)} 15 | const Framework = 'VCL'; 16 | {$Else} 17 | const Framework = 'FM'; 18 | const clNone = TAlphaColorRec.Null; 19 | const clBlack = TAlphaColorRec.Black; 20 | {$IfEnd} 21 | 22 | type 23 | {$If Framework = 'VCL'} 24 | TColorValue = TColor; 25 | {$Else} 26 | TColorValue = TAlphaColor; 27 | {$IfEnd} 28 | 29 | 30 | {$if (CompilerVersion > 22) and declared(System.Types.TPointF)} 31 | TPointF = System.Types.TPointF; 32 | {$Else} 33 | TPointF = record 34 | X: Single; 35 | Y: Single; 36 | end; 37 | {$IfEnd} 38 | 39 | {$if (CompilerVersion > 22) and declared(System.Types.TRectF)} 40 | TRectF = System.Types.TRectF; 41 | {$Else} 42 | TRectF = record 43 | Left, Top, Right, Bottom: Single; 44 | end; 45 | {$IfEnd} 46 | 47 | {$if CompilerVersion > 22} 48 | TRect = System.Types.TRect; 49 | {$Else} 50 | TRect = Types.TRect; 51 | {$IfEnd} 52 | 53 | 54 | function PointF(AX, AY: Single): TPointF; inline; 55 | function RectF(ALeft, ATop, ARight, ABottom: Single): TRectF; inline; 56 | 57 | implementation 58 | 59 | function PointF(AX, AY: Single): TPointF; 60 | begin 61 | Result.X := AX; 62 | Result.Y := AY; 63 | end; 64 | 65 | function RectF(ALeft, ATop, ARight, ABottom: Single): TRectF; 66 | begin 67 | Result.Left := ALeft; 68 | Result.Top := ATop; 69 | Result.Right := ARight; 70 | Result.Bottom := ABottom; 71 | end; 72 | 73 | end. 74 | -------------------------------------------------------------------------------- /AsciiImage.RenderContext.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.RenderContext; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Types, 8 | Graphics, 9 | AsciiImage.RenderContext.Types, 10 | AsciiImage.RenderContext.Intf; 11 | 12 | type 13 | TProperties = class(TInterfacedObject, IProperties) 14 | private 15 | FOnChanged: TPropertyChangedEvent; 16 | function GetOnChanged: TPropertyChangedEvent; 17 | procedure SetOnChanged(const Value: TPropertyChangedEvent); 18 | protected 19 | procedure Changed(); virtual; 20 | public 21 | property OnChanged: TPropertyChangedEvent read GetOnChanged write SetOnChanged; 22 | end; 23 | 24 | TBrushProperties = class(TProperties, IBrushProperties) 25 | private 26 | FColor: TColorValue; 27 | FVisible: Boolean; 28 | function GetColor: TColorValue; 29 | procedure SetColor(const Value: TColorValue); 30 | function GetVisible: Boolean; 31 | procedure SetVisible(const Value: Boolean); 32 | public 33 | property Color: TColorValue read GetColor write SetColor; 34 | property Visible: Boolean read GetVisible write SetVisible; 35 | end; 36 | 37 | TPenProperties = class(TBrushProperties, IPenProperties) 38 | private 39 | FSize: Integer; 40 | function GetSize: Integer; 41 | procedure SetSize(const Value: Integer); 42 | public 43 | property Size: Integer read GetSize write SetSize; 44 | end; 45 | 46 | TRenderContext = class(TInterfacedObject, IRenderContext) 47 | private 48 | FBrush: IBrushProperties; 49 | FPen: IPenProperties; 50 | function GetBrush: IBrushProperties; 51 | function GetPen: IPenProperties; 52 | protected 53 | procedure BrushChanged; virtual; abstract; 54 | procedure PenChanged; virtual; abstract; 55 | public 56 | procedure Clear(AColor: TColorValue); virtual; abstract; 57 | procedure DrawPolygon(const APoints: array of TPointF); virtual; abstract; 58 | procedure DrawLine(const AFrom, ATo: TPointF); virtual; abstract; 59 | procedure DrawEllipsis(const ARect: TRectF); virtual; abstract; 60 | procedure FillRectangle(const ARect: TRectF); virtual; abstract; 61 | procedure BeginScene(const ARect: TRect); virtual; 62 | procedure EndScene(); virtual; 63 | property Brush: IBrushProperties read GetBrush; 64 | property Pen: IPenProperties read GetPen; 65 | end; 66 | 67 | implementation 68 | 69 | { TProperties } 70 | 71 | procedure TProperties.Changed; 72 | begin 73 | if Assigned(FOnChanged) then 74 | FOnChanged(); 75 | end; 76 | 77 | function TProperties.GetOnChanged: TPropertyChangedEvent; 78 | begin 79 | Result := FOnChanged; 80 | end; 81 | 82 | procedure TProperties.SetOnChanged(const Value: TPropertyChangedEvent); 83 | begin 84 | FOnChanged := Value; 85 | end; 86 | 87 | { TBrushProperties } 88 | 89 | function TBrushProperties.GetColor: TColorValue; 90 | begin 91 | Result := FColor; 92 | end; 93 | 94 | function TBrushProperties.GetVisible: Boolean; 95 | begin 96 | Result := FVisible; 97 | end; 98 | 99 | procedure TBrushProperties.SetColor(const Value: TColorValue); 100 | begin 101 | if FColor <> Value then 102 | begin 103 | FColor := Value; 104 | Changed(); 105 | end; 106 | end; 107 | 108 | procedure TBrushProperties.SetVisible(const Value: Boolean); 109 | begin 110 | if FVisible <> Value then 111 | begin 112 | FVisible := Value; 113 | Changed(); 114 | end; 115 | end; 116 | 117 | { TPenProperties } 118 | 119 | function TPenProperties.GetSize: Integer; 120 | begin 121 | Result := FSize; 122 | end; 123 | 124 | procedure TPenProperties.SetSize(const Value: Integer); 125 | begin 126 | if FSize <> Value then 127 | begin 128 | FSize := Value; 129 | Changed(); 130 | end; 131 | end; 132 | 133 | { TRenderContext } 134 | 135 | procedure TRenderContext.BeginScene; 136 | begin 137 | 138 | end; 139 | 140 | procedure TRenderContext.EndScene; 141 | begin 142 | 143 | end; 144 | 145 | function TRenderContext.GetBrush: IBrushProperties; 146 | begin 147 | if not Assigned(FBrush) then 148 | begin 149 | FBrush := TBrushProperties.Create(); 150 | FBrush.OnChanged := BrushChanged; 151 | end; 152 | Result := FBrush; 153 | end; 154 | 155 | function TRenderContext.GetPen: IPenProperties; 156 | begin 157 | if not Assigned(FPen) then 158 | begin 159 | FPen := TPenProperties.Create(); 160 | FPen.OnChanged := PenChanged; 161 | end; 162 | Result := FPen; 163 | end; 164 | 165 | end. 166 | -------------------------------------------------------------------------------- /AsciiImage.Shapes.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage.Shapes; 2 | 3 | interface 4 | 5 | uses 6 | {$if CompilerVersion > 22} 7 | System.Types, 8 | {$IfEnd} 9 | Generics.Collections, 10 | AsciiImage.RenderContext.Types, 11 | AsciiImage.RenderContext.Intf; 12 | 13 | type 14 | TAsciiShape = class 15 | private 16 | FScaledPoints: TList; 17 | FPoints: TList; 18 | FScaleX: Single; 19 | FScaleY: Single; 20 | procedure SetScaleX(const Value: Single); 21 | function GetScaledPoints: TList; 22 | procedure SetScaleY(const Value: Single); 23 | public 24 | constructor Create(); 25 | destructor Destroy(); override; 26 | procedure Draw(const AContext: IRenderContext); virtual; abstract; 27 | property Points: TList read FPoints; 28 | property ScaledPoints: TList read GetScaledPoints; 29 | property ScaleX: Single read FScaleX write SetScaleX; 30 | property ScaleY: Single read FScaleY write SetScaleY; 31 | end; 32 | 33 | TAsciiEllipsis = class(TAsciiShape) 34 | protected 35 | function GetRect(): TRectF; 36 | public 37 | procedure Draw(const AContext: IRenderContext); override; 38 | end; 39 | 40 | TAsciiPath = class(TAsciiShape) 41 | public 42 | procedure Draw(const AContext: IRenderContext); override; 43 | end; 44 | 45 | TAsciiDot = class(TAsciiShape) 46 | public 47 | procedure Draw(const AContext: IRenderContext); override; 48 | end; 49 | 50 | TAsciiLine = class(TAsciiShape) 51 | public 52 | procedure Draw(const AContext: IRenderContext); override; 53 | end; 54 | 55 | implementation 56 | 57 | { TAsciiShape } 58 | 59 | constructor TAsciiShape.Create; 60 | begin 61 | inherited; 62 | FPoints := TList.Create(); 63 | FScaledPoints := TList.Create(); 64 | end; 65 | 66 | destructor TAsciiShape.Destroy; 67 | begin 68 | FPoints.Free; 69 | FScaledPoints.Free; 70 | end; 71 | 72 | function TAsciiShape.GetScaledPoints: TList; 73 | var 74 | LPoint: TPointF; 75 | begin 76 | if FScaledPoints.Count = 0 then 77 | begin 78 | for LPoint in Points do 79 | begin 80 | FScaledPoints.Add(PointF(LPoint.X*ScaleX + ScaleX/2, LPoint.Y*ScaleY + ScaleY / 2)); 81 | end; 82 | end; 83 | Result := FScaledPoints; 84 | end; 85 | 86 | procedure TAsciiShape.SetScaleX(const Value: Single); 87 | begin 88 | FScaleX := Value; 89 | FScaledPoints.Clear; 90 | end; 91 | 92 | procedure TAsciiShape.SetScaleY(const Value: Single); 93 | begin 94 | if FScaleY <> Value then 95 | begin 96 | FScaleY := Value; 97 | FScaledPoints.Clear; 98 | end; 99 | end; 100 | 101 | { TAsciiLine } 102 | 103 | procedure TAsciiLine.Draw(const AContext: IRenderContext); 104 | begin 105 | AContext.DrawLine(ScaledPoints[0], ScaledPoints[1]); 106 | end; 107 | 108 | { TAsciiDot } 109 | 110 | procedure TAsciiDot.Draw(const AContext: IRenderContext); 111 | var 112 | LPoint: TPointF; 113 | LRect: TRectF; 114 | begin 115 | LPoint := ScaledPoints[0]; 116 | LRect.Left := LPoint.X - ScaleX / 2; 117 | LRect.Top := LPoint.Y - ScaleY / 2; 118 | LRect.Right := LPoint.X + ScaleX / 2; 119 | LRect.Bottom := LPoint.Y + ScaleY / 2; 120 | AContext.FillRectangle(LRect); 121 | end; 122 | 123 | { TAsciiPath } 124 | 125 | procedure TAsciiPath.Draw(const AContext: IRenderContext); 126 | begin 127 | AContext.DrawPolygon(ScaledPoints.ToArray); 128 | end; 129 | 130 | { TAsciiEllipsis } 131 | 132 | procedure TAsciiEllipsis.Draw(const AContext: IRenderContext); 133 | begin 134 | AContext.DrawEllipsis(GetRect()); 135 | end; 136 | 137 | function TAsciiEllipsis.GetRect: TRectF; 138 | var 139 | LPoint: TPointF; 140 | const 141 | CHighSingle = 10000; 142 | CLowSingle = -10000; 143 | begin 144 | Result.Left := CHighSingle; 145 | Result.Top := CHighSingle; 146 | Result.Right := CLowSingle; 147 | Result.Bottom := CLowSingle; 148 | for LPoint in ScaledPoints do 149 | begin 150 | if LPoint.X < Result.Left then 151 | Result.Left := LPoint.X; 152 | 153 | if LPoint.X > Result.Right then 154 | Result.Right := LPoint.X; 155 | 156 | if LPoint.Y < Result.Top then 157 | Result.Top := LPoint.Y; 158 | 159 | if LPoint.Y > Result.Bottom then 160 | Result.Bottom := LPoint.Y; 161 | end; 162 | end; 163 | 164 | end. 165 | -------------------------------------------------------------------------------- /AsciiImage.pas: -------------------------------------------------------------------------------- 1 | unit AsciiImage; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | {$if CompilerVersion > 22} 8 | System.Types, 9 | System.UITypes, 10 | {$Else} 11 | Types, 12 | {$IfEnd} 13 | SysUtils, 14 | Graphics, 15 | Generics.Collections, 16 | AsciiImage.RenderContext.Types, 17 | {$if Framework = 'VCL'} 18 | Windows, 19 | {$IfEnd} 20 | AsciiImage.Shapes, 21 | AsciiImage.RenderContext.Factory, 22 | AsciiImage.RenderContext.Intf; 23 | 24 | type 25 | TAsciiImagePaintContext = record 26 | FillColor: TColorValue; 27 | StrokeColor: TColorValue; 28 | PenSize: Integer; 29 | end; 30 | 31 | TAsciiImagePaintCallBack = reference to procedure(const Index: Integer; var Context: TAsciiImagePaintContext); 32 | 33 | TDownSampling = (dsNone, dsX2, dsX4, dsX8); 34 | 35 | {$if Framework = 'VCL'} 36 | TAsciiImage = class(TGraphic) 37 | {$ELSE} 38 | TAsciiImage = class(TInterfacedPersistent) 39 | {$IfEnd} 40 | private 41 | FRawData: TArray; 42 | FDots: array of TList; 43 | FShapes: TObjectList; 44 | FIndexLookup: TDictionary; 45 | FWidth: Integer; 46 | FHeight: Integer; 47 | FOnDraw: TAsciiImagePaintCallBack; 48 | FOnCreateRenderContext: TCreateRenderContextHook; 49 | protected 50 | procedure Clear(); 51 | procedure ScanShapes(); virtual; 52 | procedure AddDot(APoint: TPointF); virtual; 53 | procedure AddEllipsis(const APoints: array of TPointF); virtual; 54 | procedure AddPath(const APoints: array of TPointF); virtual; 55 | procedure AddLine(const AFrom, ATo: TPointF); virtual; 56 | function CreateRenderContext(ACanvas: TCanvas; AWidth, AHeight: Single): IRenderContext; 57 | {$If Framework = 'VCL'} 58 | function GetEmpty: Boolean; override; 59 | function GetHeight: Integer; override; 60 | function GetWidth: Integer; override; 61 | procedure SetHeight(Value: Integer); override; 62 | procedure SetWidth(Value: Integer); override; 63 | {$Else} 64 | function GetEmpty: Boolean; 65 | function GetHeight: Integer; 66 | function GetWidth: Integer; 67 | procedure SetHeight(Value: Integer); 68 | procedure SetWidth(Value: Integer); 69 | {$IfEnd} 70 | public 71 | {$if Framework = 'VCL'} 72 | constructor Create(); override; 73 | {$Else} 74 | constructor Create(); 75 | {$IfEnd} 76 | destructor Destroy(); override; 77 | procedure LoadFromAscii(const AAsciiImage: array of string); 78 | procedure SaveToAscii(var AAsciiImage: TArray); 79 | {$If Framework = 'VCL'} 80 | procedure DrawDebugGrid(const ACanvas: TCanvas); 81 | procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; 82 | procedure LoadFromStream(Stream: TStream); override; 83 | procedure SaveToStream(Stream: TStream); override; 84 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; 85 | APalette: HPALETTE); override; 86 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; 87 | var APalette: HPALETTE); override; 88 | {$Else} 89 | procedure Draw(ACanvas: TCanvas; const ARect: TRect); 90 | procedure LoadFromStream(Stream: TStream); 91 | procedure SaveToStream(Stream: TStream); 92 | procedure LoadFromFile(const AFileName: string); 93 | procedure SaveToFile(const AFileName: string); 94 | {$IfEnd} 95 | procedure Assign(Source: TPersistent); override; 96 | property OnDraw: TAsciiImagePaintCallBack read FOnDraw write FOnDraw; 97 | property OnCreateRenderContext: TCreateRenderContextHook read FOnCreateRenderContext write FOnCreateRenderContext; 98 | {$If Framework = 'FM'} 99 | property Width: Integer read GetWidth write SetWidth; 100 | property Height: Integer read GetHeight write SetHeight; 101 | property Empty: Boolean read GetEmpty; 102 | {$IfEnd} 103 | end; 104 | 105 | implementation 106 | 107 | uses 108 | Math; 109 | 110 | { TAsciiImage } 111 | 112 | const 113 | CCharSet = ['1'..'9', 'A'..'Z', 'a'..'z']; 114 | 115 | procedure TAsciiImage.AddDot(APoint: TPointF); 116 | var 117 | LDot: TAsciiDot; 118 | begin 119 | LDot := TAsciiDot.Create(); 120 | LDot.Points.Add(APoint); 121 | FShapes.Add(LDot); 122 | end; 123 | 124 | procedure TAsciiImage.AddEllipsis(const APoints: array of TPointF); 125 | var 126 | LEllipsis: TAsciiEllipsis; 127 | begin 128 | LEllipsis := TAsciiEllipsis.Create(); 129 | LEllipsis.Points.AddRange(APoints); 130 | FShapes.Add(LEllipsis); 131 | end; 132 | 133 | procedure TAsciiImage.AddLine(const AFrom, ATo: TPointF); 134 | var 135 | LLine: TAsciiLine; 136 | begin 137 | LLine := TAsciiLine.Create(); 138 | LLine.Points.Add(AFrom); 139 | LLine.Points.Add(ATo); 140 | FShapes.Add(LLine); 141 | end; 142 | 143 | procedure TAsciiImage.AddPath(const APoints: array of TPointF); 144 | var 145 | LPath: TAsciiPath; 146 | begin 147 | LPath := TAsciiPath.Create(); 148 | LPath.Points.AddRange(APoints); 149 | FShapes.Add(LPath); 150 | end; 151 | 152 | procedure TAsciiImage.Assign(Source: TPersistent); 153 | var 154 | LSource: TAsciiImage; 155 | begin 156 | if Source is TAsciiImage then 157 | begin 158 | LSource := TAsciiImage(Source); 159 | OnDraw := LSource.OnDraw; 160 | LoadFromAscii(LSource.FRawData); 161 | end 162 | else 163 | begin 164 | inherited; 165 | end; 166 | end; 167 | 168 | procedure TAsciiImage.Clear; 169 | begin 170 | FShapes.Clear; 171 | end; 172 | 173 | constructor TAsciiImage.Create; 174 | var 175 | i: Integer; 176 | LChar: Char; 177 | begin 178 | inherited; 179 | FShapes := TObjectList.Create(True); 180 | FIndexLookup := TDictionary.Create(); 181 | i := 0; 182 | for LChar in CCharSet do 183 | begin 184 | FIndexLookup.Add(LChar, i); 185 | Inc(i); 186 | end; 187 | SetLength(FDots, FIndexLookup.Count); 188 | for i := 0 to Length(FDots) - 1 do 189 | begin 190 | FDots[i] := TList.Create(); 191 | end; 192 | FWidth := 0; 193 | FHeight := 0; 194 | end; 195 | 196 | function TAsciiImage.CreateRenderContext(ACanvas: TCanvas; AWidth, 197 | AHeight: Single): IRenderContext; 198 | begin 199 | if Assigned(FOnCreateRenderContext) then 200 | begin 201 | Result := FOnCreateRenderContext(ACanvas, AWidth, AHeight); 202 | end 203 | else 204 | begin 205 | Result := TRenderContextFactory.CreateDefaultRenderContext(ACanvas, AWidth, AHeight); 206 | end; 207 | 208 | end; 209 | 210 | destructor TAsciiImage.Destroy; 211 | var 212 | LDotList: TList; 213 | begin 214 | for LDotList in FDots do 215 | LDotList.Free; 216 | 217 | SetLength(FDots, 0); 218 | FShapes.Free(); 219 | FIndexLookup.Free(); 220 | inherited; 221 | end; 222 | 223 | procedure TAsciiImage.Draw(ACanvas: TCanvas; const ARect: TRect); 224 | var 225 | LContext: IRenderContext; 226 | i: Integer; 227 | LScaleX, LScaleY: Single; 228 | LPaintContext: TAsciiImagePaintContext; 229 | begin 230 | if Empty then Exit; 231 | 232 | LScaleX := (ARect.Right - ARect.Left) / FWidth; 233 | LScaleY := (ARect.Bottom - ARect.Top) / FHeight; 234 | LContext := CreateRenderContext(ACanvas, Width*LScaleX, Height*LScaleY); 235 | LContext.BeginScene(ARect); 236 | {$If Framework = 'VCL'} 237 | LContext.Clear(ACanvas.Brush.Color); 238 | {$Else} 239 | LContext.Clear(ACanvas.Fill.Color); 240 | {$IfEnd} 241 | 242 | for i := 0 to FShapes.Count - 1 do 243 | begin 244 | LPaintContext.FillColor := clNone; 245 | LPaintContext.StrokeColor := clNone; 246 | LPaintContext.PenSize :=1; 247 | if Assigned(FOnDraw) then 248 | begin 249 | FOnDraw(i, LPaintContext); 250 | end 251 | else 252 | begin 253 | //some defaultvalues to see something 254 | LPaintContext.FillColor := clBlack; 255 | LPaintContext.StrokeColor := clBlack; 256 | end; 257 | 258 | LContext.Brush.Color := LPaintContext.FillColor; 259 | LContext.Pen.Color := LPaintContext.StrokeColor; 260 | LContext.Pen.Size := Round(LPaintContext.PenSize*LScaleX); 261 | LContext.Brush.Visible := LContext.Brush.Color <> clNone; 262 | LContext.Pen.Visible := LContext.Pen.Color <> clNone; 263 | FShapes[i].ScaleX := LScaleX; 264 | FShapes[i].ScaleY := LScaleY; 265 | FShapes[i].Draw(LContext); 266 | end; 267 | LContext.EndScene(); 268 | end; 269 | 270 | {$If FrameWork = 'VCL'} 271 | procedure TAsciiImage.DrawDebugGrid(const ACanvas: TCanvas); 272 | var 273 | LScaleX, LScaleY: Single; 274 | i: Integer; 275 | LMode: TPenMode; 276 | LColor: TColorValue; 277 | begin 278 | LScaleX := (ACanvas.ClipRect.Right - ACanvas.ClipRect.Left) / FWidth; 279 | LScaleY := (ACanvas.ClipRect.Bottom - ACanvas.ClipRect.Top) / FHeight; 280 | LMode := ACanvas.Pen.Mode; 281 | ACanvas.Pen.Mode := pmXor; 282 | LColor := ACanvas.Pen.Color; 283 | ACanvas.Pen.Color := clRed; 284 | for i := 1 to FWidth do 285 | begin 286 | ACanvas.MoveTo(Round(i*LScaleX), ACanvas.ClipRect.Top); 287 | ACanvas.LineTo(Round(i*LScaleX), ACanvas.ClipRect.Bottom); 288 | end; 289 | 290 | for i := 1 to FHeight do 291 | begin 292 | ACanvas.MoveTo(ACanvas.ClipRect.Left, Round(i*LScaleY)); 293 | ACanvas.LineTo(ACanvas.ClipRect.Right, Round(i*LScaleY)); 294 | end; 295 | ACanvas.Pen.Mode := LMode; 296 | ACanvas.Pen.Color := LColor; 297 | end; 298 | 299 | procedure TAsciiImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle; 300 | APalette: HPALETTE); 301 | begin 302 | raise ENotSupportedException.Create('Loading form Clippboard not supported'); 303 | end; 304 | 305 | procedure TAsciiImage.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; 306 | var APalette: HPALETTE); 307 | begin 308 | raise ENotSupportedException.Create('Saving to Clippboard not supported'); 309 | end; 310 | {$IfEnd} 311 | 312 | function TAsciiImage.GetEmpty: Boolean; 313 | begin 314 | Result := FShapes.Count = 0; 315 | end; 316 | 317 | function TAsciiImage.GetHeight: Integer; 318 | begin 319 | Result := FHeight; 320 | end; 321 | 322 | function TAsciiImage.GetWidth: Integer; 323 | begin 324 | Result := FWidth; 325 | end; 326 | 327 | procedure TAsciiImage.LoadFromAscii(const AAsciiImage: array of string); 328 | var 329 | LLineIndex: Integer; 330 | LFirstLineLength, LCurrentLineLength: Integer; 331 | LCharIndex: Integer; 332 | LChar: Char; 333 | i: Integer; 334 | begin 335 | SetLength(FRawData, Length(AAsciiImage)); 336 | for i := 0 to Length(AAsciiImage) - 1 do 337 | begin 338 | FRawData[i] := AAsciiImage[i]; 339 | end; 340 | 341 | LFirstLineLength := -1; 342 | for LLineIndex := 0 to Length(AAsciiImage) - 1 do 343 | begin 344 | LCurrentLineLength := 0; 345 | for LChar in AAsciiImage[LLineIndex] do 346 | begin 347 | if LChar <> ' ' then 348 | begin 349 | if FIndexLookup.TryGetValue(LChar, LCharIndex) then 350 | begin 351 | FDots[LCharIndex].Add(PointF(LCurrentLineLength, LLineIndex)); 352 | end; 353 | Inc(LCurrentLineLength); 354 | end; 355 | end; 356 | if LFirstLineLength < 0 then 357 | begin 358 | LFirstLineLength := LCurrentLineLength; 359 | end 360 | else 361 | begin 362 | if LFirstLineLength <> LCurrentLineLength then 363 | raise Exception.Create('Length of line ' + IntToStr(LLineIndex) + '(' + IntToStr(LFirstLineLength) 364 | + ') does not match length of first line (' + IntToStr(LFirstLineLength) + ')'); 365 | end; 366 | end; 367 | FWidth := LFirstLineLength; 368 | FHeight := Length(AAsciiImage); 369 | ScanShapes(); 370 | end; 371 | 372 | {$if Framework = 'FM'} 373 | procedure TAsciiImage.LoadFromFile(const AFileName: string); 374 | var 375 | LStream: TStream; 376 | begin 377 | LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite); 378 | try 379 | LoadFromStream(LStream); 380 | finally 381 | LStream.Free; 382 | end; 383 | end; 384 | 385 | procedure TAsciiImage.SaveToFile(const AFileName: string); 386 | var 387 | LStream: TStream; 388 | begin 389 | LStream := TFileStream.Create(AFileName, fmCreate); 390 | try 391 | SaveToStream(LStream); 392 | finally 393 | LStream.Free; 394 | end; 395 | end; 396 | {$IfEnd} 397 | 398 | procedure TAsciiImage.LoadFromStream(Stream: TStream); 399 | var 400 | LAscii: TStringList; 401 | begin 402 | LAscii := TStringList.Create(); 403 | try 404 | LAscii.LoadFromStream(Stream); 405 | LoadFromAscii(LAscii.ToStringArray); 406 | finally 407 | LAscii.Free(); 408 | end; 409 | end; 410 | 411 | procedure TAsciiImage.SaveToAscii(var AAsciiImage: TArray); 412 | var 413 | i: Integer; 414 | begin 415 | SetLength(AAsciiImage, Length(FRawData)); 416 | for i := 0 to Length(FRawData) - 1 do 417 | begin 418 | AAsciiImage[i] := FRawData[i]; 419 | end; 420 | end; 421 | 422 | procedure TAsciiImage.SaveToStream(Stream: TStream); 423 | var 424 | LAscii: TStringList; 425 | begin 426 | LAscii := TStringList.Create(); 427 | try 428 | LAscii.AddStrings(FRawData); 429 | LAscii.SaveToStream(Stream); 430 | finally 431 | LAscii.Free; 432 | end; 433 | end; 434 | 435 | procedure TAsciiImage.ScanShapes; 436 | var 437 | LPathStart, LPathLength: Integer; 438 | i, k: Integer; 439 | LPoints: array of TPointF; 440 | begin 441 | LPathStart := -1; 442 | for i := 0 to Length(FDots) - 1 do 443 | begin 444 | //we have one dot for this char and haven't started a path yet? 445 | //mark it as path-start 446 | if FDots[i].Count = 1 then 447 | begin 448 | if LPathStart = -1 then 449 | LPathStart := i; 450 | end 451 | else 452 | begin 453 | if FDots[i].Count = 2 then 454 | AddLine(FDots[i][0], FDots[i][1]); 455 | 456 | if FDots[i].Count > 2 then 457 | AddEllipsis(FDots[i].ToArray); 458 | end; 459 | 460 | //did we start a path? Is the current dot not part of a path?(Marks end) or is it the last dot? 461 | if (LPathStart > -1) and ((FDots[i].Count <> 1) or (i = Length(FDots) - 1)) then 462 | begin 463 | //in case the final point is simply a path of length 1, pathlength is 0, because 464 | //i = LPathStart 465 | //anything with more than 1 point is a path, anything below is just a dot 466 | LPathLength := i - LPathStart; 467 | if LPathLength < 2 then 468 | begin 469 | AddDot(FDots[LPathStart][0]); 470 | end 471 | else 472 | begin 473 | SetLength(LPoints, Max(LPathLength, 1)); 474 | for k := 0 to Length(LPoints) - 1 do 475 | begin 476 | LPoints[k] := FDots[k + LPathStart][0]; 477 | end; 478 | AddPath(LPoints); 479 | end; 480 | LPathStart := -1; 481 | end; 482 | end; 483 | end; 484 | 485 | procedure TAsciiImage.SetHeight(Value: Integer); 486 | begin 487 | inherited; 488 | if FHeight <> Value then 489 | begin 490 | FHeight := Value; 491 | Clear(); 492 | end; 493 | end; 494 | 495 | procedure TAsciiImage.SetWidth(Value: Integer); 496 | begin 497 | inherited; 498 | if FWidth <> Value then 499 | begin 500 | FWidth := Value; 501 | Clear(); 502 | end; 503 | end; 504 | 505 | {$if Framework = 'VCL'} 506 | initialization 507 | TPicture.RegisterFileFormat('AIMG', 'Ascii Image Graphic', TAsciiImage); 508 | TPicture.RegisterFileFormat('AsciiImage', 'Ascii Image Graphic', TAsciiImage); 509 | 510 | finalization 511 | TPicture.UnregisterGraphicClass(TAsciiImage); 512 | {$IfEnd} 513 | 514 | end. 515 | -------------------------------------------------------------------------------- /Delphinus.Info.json: -------------------------------------------------------------------------------- 1 | { 2 | "id": "{D25D0A04-F8CC-45FB-947C-0A917BB9E45F}", 3 | "picture": "Logo.jpg", 4 | "license_type": "MIT", 5 | "license_file": "License", 6 | "platforms": "Win32;Win64", 7 | "package_compiler_min": 22, 8 | "compiler_min": 22 9 | } -------------------------------------------------------------------------------- /Delphinus.Install.json: -------------------------------------------------------------------------------- 1 | { 2 | "search_pathes": 3 | [ 4 | { 5 | "pathes": ".", 6 | "platforms": "Win32;Win64" 7 | } 8 | ], 9 | 10 | "source_folders": 11 | [ 12 | { 13 | "folder": ".", 14 | "recursive": false, 15 | "filter": "*.pas;ReadMe.txt" 16 | }, 17 | 18 | { 19 | "folder": "Demo", 20 | "recursive": true, 21 | "filter": "*.*;*" 22 | }, 23 | 24 | { 25 | "folder": "FMDemo", 26 | "recursive": true, 27 | "filter": "*.*;*" 28 | }, 29 | 30 | { 31 | "folder": "Packages", 32 | "recursive": true, 33 | "filter": "*.*;*" 34 | } 35 | ], 36 | 37 | "projects": 38 | [ 39 | { 40 | "project": "Packages\\DelphiXE\\AsciiImageDesign.dproj", 41 | "compiler_min": 22, 42 | "compiler_max": 26 43 | }, 44 | 45 | { 46 | "project": "Packages\\DelphiXE6\\AsciiImageDesign.dproj", 47 | "compiler_min": 27 48 | } 49 | ] 50 | } -------------------------------------------------------------------------------- /Demo/Debug/Win32/Test.aig: -------------------------------------------------------------------------------- 1 | . . . . . 2 | . 1 . 1 . 3 | . . . . . 4 | . 1 . 1 . 5 | . . . . . 6 | -------------------------------------------------------------------------------- /Demo/Debug/Win32/fixture10.txt: -------------------------------------------------------------------------------- 1 | · · · · · · · · · · · · · · 2 | · · · 1 · · · · · · 1 · · · 3 | · · · · · · · · · · · · · · 4 | · · · · · · · · · · · · · · 5 | · · · · · · · · · · · · · · 6 | · 3 · 1 · · · · · · 1 · 4 · 7 | · · · · · · · · · · · · · · 8 | · · · · · A · · A · · · · · 9 | · · · 1 · · · · · · 1 · · · 10 | · · · · · · C D · · · · · · 11 | · · · · · A · · A · · · · · 12 | · · · · · · · · · · · · · · 13 | · · · · · · B E · · · · · · 14 | · · · · · · · · · · · · · · 15 | · 6 · · · · · · · · · · 5 · -------------------------------------------------------------------------------- /Demo/Debug/Win32/fixture6.txt: -------------------------------------------------------------------------------- 1 | · · · · · · · · · · · · 2 | · · · 1 2 · · · · · · · 3 | · · · A # # · · · · · · 4 | · · · · # # # · · · · · 5 | · · · · · # # # · · · · 6 | · · · · · · 9 # 3 · · · 7 | · · · · · · 8 # 4 · · · 8 | · · · · · # # # · · · · 9 | · · · · # # # · · · · · 10 | · · · 7 # # · · · · · · 11 | · · · 6 5 · · · · · · · 12 | · · · · · · · · · · · · -------------------------------------------------------------------------------- /Demo/Demo.dpr: -------------------------------------------------------------------------------- 1 | program Demo; 2 | 3 | uses 4 | Forms, 5 | Main in 'Main.pas' {Form1}, 6 | AsciiImage in '..\AsciiImage.pas', 7 | AsciiImage.Shapes in '..\AsciiImage.Shapes.pas', 8 | AsciiImage.RenderContext in '..\AsciiImage.RenderContext.pas', 9 | AsciiImage.RenderContext.Intf in '..\AsciiImage.RenderContext.Intf.pas', 10 | AsciiImage.RenderContext.Types in '..\AsciiImage.RenderContext.Types.pas', 11 | AsciiImage.RenderContext.GDI in '..\AsciiImage.RenderContext.GDI.pas', 12 | AsciiImage.RenderContext.Factory in '..\AsciiImage.RenderContext.Factory.pas'; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | Application.MainFormOnTaskbar := True; 19 | Application.CreateForm(TForm1, Form1); 20 | Application.Run; 21 | end. 22 | -------------------------------------------------------------------------------- /Demo/Demo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {866EE2D5-7BA6-4C82-808F-54CAA00474AA} 4 | Demo.dpr 5 | 15.4 6 | True 7 | Debug 8 | Application 9 | VCL 10 | DCC32 11 | 1 12 | Win32 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | 1031 39 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 40 | Demo 41 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 42 | false 43 | false 44 | .\$(Config)\$(Platform) 45 | .\$(Config)\$(Platform) 46 | false 47 | false 48 | 00400000 49 | false 50 | 51 | 52 | 1033 53 | true 54 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 55 | Demo_Icon.ico 56 | $(BDS)\bin\default_app.manifest 57 | 58 | 59 | $(BDS)\bin\default_app.manifest 60 | Demo_Icon.ico 61 | 62 | 63 | DEBUG;$(DCC_Define) 64 | true 65 | false 66 | 67 | 68 | RELEASE;$(DCC_Define) 69 | 0 70 | false 71 | 0 72 | 73 | 74 | 75 | MainSource 76 | 77 | 78 |
Form1
79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | Cfg_2 89 | Base 90 | 91 | 92 | Base 93 | 94 | 95 | Cfg_1 96 | Base 97 | 98 | 99 | 100 | 101 | 102 | Delphi.Personality.12 103 | 104 | 105 | 106 | 107 | Demo.dpr 108 | 109 | 110 | False 111 | False 112 | 1 113 | 0 114 | 0 115 | 0 116 | False 117 | False 118 | False 119 | False 120 | False 121 | 1031 122 | 1252 123 | 124 | 125 | 126 | 127 | 1.0.0.0 128 | 129 | 130 | 131 | 132 | 133 | 1.0.0.0 134 | 135 | 136 | 137 | 138 | True 139 | False 140 | 141 | 142 | 12 143 | 144 | 145 | -------------------------------------------------------------------------------- /Demo/Main.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 290 6 | ClientWidth = 554 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 554 16 | 290) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Image1: TImage 20 | Left = 8 21 | Top = 8 22 | Width = 128 23 | Height = 128 24 | Stretch = True 25 | end 26 | object Button1: TButton 27 | Left = 471 28 | Top = 8 29 | Width = 75 30 | Height = 25 31 | Anchors = [akTop, akRight] 32 | Caption = 'Button1' 33 | TabOrder = 0 34 | OnClick = Button1Click 35 | end 36 | object Memo1: TMemo 37 | Left = 139 38 | Top = 8 39 | Width = 326 40 | Height = 274 41 | Anchors = [akLeft, akTop, akRight, akBottom] 42 | Font.Charset = DEFAULT_CHARSET 43 | Font.Color = clWindowText 44 | Font.Height = -11 45 | Font.Name = 'Courier New' 46 | Font.Style = [] 47 | Lines.Strings = ( 48 | 'Memo1') 49 | ParentFont = False 50 | ScrollBars = ssBoth 51 | TabOrder = 1 52 | end 53 | object cbGrid: TCheckBox 54 | Left = 8 55 | Top = 142 56 | Width = 97 57 | Height = 17 58 | Caption = 'Grid' 59 | TabOrder = 2 60 | OnClick = Button1Click 61 | end 62 | object Button2: TButton 63 | Left = 471 64 | Top = 39 65 | Width = 75 66 | Height = 25 67 | Caption = 'Button2' 68 | TabOrder = 3 69 | OnClick = Button1Click 70 | end 71 | end 72 | -------------------------------------------------------------------------------- /Demo/Main.pas: -------------------------------------------------------------------------------- 1 | unit Main; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, ExtCtrls, StdCtrls, AsciiImage; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | Button1: TButton; 12 | Image1: TImage; 13 | Memo1: TMemo; 14 | cbGrid: TCheckBox; 15 | Button2: TButton; 16 | procedure Button1Click(Sender: TObject); 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | Form1: TForm1; 25 | 26 | implementation 27 | 28 | uses 29 | AsciiImage.RenderContext.Intf, 30 | AsciiImage.RenderContext.GDI, 31 | AsciiImage.RenderContext.Types; 32 | 33 | {$R *.dfm} 34 | 35 | const 36 | CDot: array[0..4] of string = 37 | ( 38 | '. . . . .', 39 | '. . . . .', 40 | '. . 1 . .', 41 | '. . . . .', 42 | '. . . . .' 43 | ); 44 | 45 | CLine: array[0..4] of string = 46 | ( 47 | '. . . . .', 48 | '. . 2 . .', 49 | '. 1 . 1 .', 50 | '. . 2 . .', 51 | '. . . . .' 52 | ); 53 | 54 | CLineB: array[0..4] of string = 55 | ( 56 | '1 . . . 2', 57 | '. . . . .', 58 | '. . . . .', 59 | '. . . . .', 60 | '2 . . . 1' 61 | ); 62 | 63 | CEllipsis: array[0..4] of string = 64 | ( 65 | '. . . . .', 66 | '. 1 . 1 .', 67 | '. . . . .', 68 | '. 1 . 1 .', 69 | '. . . . .' 70 | ); 71 | 72 | CPath: array[0..4] of string = 73 | ( 74 | '. . . . .', 75 | '. 1 . 2 .', 76 | '. 6 5 . .', 77 | '. . 4 3 .', 78 | '. . . . .' 79 | ); 80 | 81 | CPathB: array[0..4] of string = 82 | ( 83 | '. . . . .', 84 | '. . . 2 .', 85 | '. . . . .', 86 | '. . . 3 .', 87 | '. . . . .' 88 | ); 89 | 90 | procedure TForm1.Button1Click(Sender: TObject); 91 | var 92 | LImage: TAsciiImage; 93 | begin 94 | Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height); 95 | LImage := TAsciiImage.Create(); 96 | try 97 | if Sender = Button1 then 98 | Memo1.Lines.LoadFromFile('Fixture10.txt'); 99 | LImage.LoadFromAscii(Memo1.Lines.ToStringArray); 100 | LImage.OnDraw := procedure(const AIndex: Integer; var AContext: TAsciiImagePaintContext) 101 | begin 102 | AContext.FillColor := clBlack; 103 | AContext.StrokeColor := clBlack; 104 | if (AIndex <> 1) then 105 | begin 106 | AContext.FillColor := clWhite; 107 | if AIndex > 1 then 108 | AContext.StrokeColor := clWhite; 109 | end; 110 | end; 111 | Image1.Picture.Bitmap.Canvas.StretchDraw(Image1.Picture.Bitmap.Canvas.ClipRect, LImage); 112 | if cbGrid.Checked then 113 | LImage.DrawDebugGrid(Image1.Picture.Bitmap.Canvas); 114 | 115 | finally 116 | LImage.Free; 117 | end; 118 | end; 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /FMDemo/FMDemo.dpr: -------------------------------------------------------------------------------- 1 | program FMDemo; 2 | 3 | uses 4 | FMX.Forms, 5 | Main in 'Main.pas' {Form2}, 6 | AsciiImage.RenderContext.FM in '..\AsciiImage.RenderContext.FM.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TForm2, Form2); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /FMDemo/FMDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {04856FFA-1E21-4FA8-A1D8-EEED7BA28D78} 4 | 15.4 5 | FMX 6 | FMDemo.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Cfg_1 39 | true 40 | true 41 | 42 | 43 | true 44 | Base 45 | true 46 | 47 | 48 | $(BDS)\bin\delphi_PROJECTICNS.icns 49 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 50 | $(BDS)\bin\delphi_PROJECTICON.ico 51 | FMDemo 52 | .\$(Platform)\$(Config) 53 | .\$(Platform)\$(Config) 54 | false 55 | false 56 | false 57 | false 58 | false 59 | 60 | 61 | bindcompfmx;DBXSqliteDriver;RESTBackendComponents;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;tethering;bindcomp;inetdb;DBXInterBaseDriver;xmlrtl;DbxCommonDriver;IndyProtocols;dbxcds;DBXMySQLDriver;soaprtl;bindengine;bindcompdbx;FMXTee;CustomIPTransport;dsnap;IndyIPServer;fmxase;IndyCore;IndyIPCommon;CloudService;FmxTeeUI;inet;fmxobj;soapserver;soapmidas;inetdbxpress;dsnapxml;fmxdae;RESTComponents;dbexpress;IndyIPClient;$(DCC_UsePackage) 62 | 63 | 64 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 65 | 1033 66 | true 67 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 68 | bindcompfmx;DBXSqliteDriver;vcldbx;RESTBackendComponents;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;tethering;bindcomp;inetdb;TeeDB;inetdbbde;DBXInterBaseDriver;Tee;xmlrtl;svnui;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;MetropolisUILiveTile;soaprtl;vclactnband;bindengine;vcldb;bindcompdbx;vcldsnap;bindcompvcl;FMXTee;TeeUI;vclie;vcltouch;CustomIPTransport;vclribbon;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;CloudService;dsnapcon;FmxTeeUI;inet;fmxobj;soapserver;soapmidas;vclx;inetdbxpress;svn;dsnapxml;fmxdae;RESTComponents;bdertl;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) 69 | $(BDS)\bin\default_app.manifest 70 | 71 | 72 | bindcompfmx;DBXSqliteDriver;RESTBackendComponents;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;tethering;bindcomp;inetdb;TeeDB;DBXInterBaseDriver;Tee;xmlrtl;DbxCommonDriver;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;MetropolisUILiveTile;soaprtl;vclactnband;bindengine;vcldb;bindcompdbx;vcldsnap;bindcompvcl;FMXTee;TeeUI;vclie;vcltouch;CustomIPTransport;vclribbon;VclSmp;dsnap;IndyIPServer;VCLRESTComponents;fmxase;vcl;IndyCore;IndyIPCommon;CloudService;dsnapcon;FmxTeeUI;inet;fmxobj;soapserver;soapmidas;vclx;inetdbxpress;dsnapxml;fmxdae;RESTComponents;adortl;dbexpress;IndyIPClient;$(DCC_UsePackage) 73 | 74 | 75 | DEBUG;$(DCC_Define) 76 | true 77 | false 78 | true 79 | true 80 | true 81 | 82 | 83 | FMX;$(DCC_Namespace) 84 | 1033 85 | true 86 | ..;$(DCC_UnitSearchPath) 87 | false 88 | 89 | 90 | false 91 | RELEASE;$(DCC_Define) 92 | 0 93 | 0 94 | 95 | 96 | 97 | MainSource 98 | 99 | 100 |
Form2
101 | fmx 102 | 103 | 104 | 105 | Cfg_2 106 | Base 107 | 108 | 109 | Base 110 | 111 | 112 | Cfg_1 113 | Base 114 | 115 | 116 | 117 | Delphi.Personality.12 118 | 119 | 120 | 121 | 122 | FMDemo.dpr 123 | 124 | 125 | Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver 126 | Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server 127 | 128 | 129 | 130 | 131 | False 132 | True 133 | False 134 | 135 | 136 | 12 137 | 138 | 139 | 140 | 141 | -------------------------------------------------------------------------------- /FMDemo/Main.fmx: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form2' 5 | ClientHeight = 295 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop, iPhone, iPad] 10 | OnCreate = FormCreate 11 | OnDestroy = FormDestroy 12 | DesignerMobile = False 13 | DesignerWidth = 0 14 | DesignerHeight = 0 15 | DesignerDeviceName = '' 16 | DesignerOrientation = 0 17 | DesignerOSVersion = '' 18 | object Memo1: TMemo 19 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 20 | Anchors = [akLeft, akTop, akRight, akBottom] 21 | Height = 273.000000000000000000 22 | Position.X = 144.000000000000000000 23 | Position.Y = 8.000000000000000000 24 | TabOrder = 1 25 | Width = 297.000000000000000000 26 | TextSettings.Font.Family = 'Courier New' 27 | StyledSettings = [Size, Style, FontColor] 28 | end 29 | object Button1: TButton 30 | Height = 22.000000000000000000 31 | Position.X = 448.000000000000000000 32 | Position.Y = 8.000000000000000000 33 | TabOrder = 2 34 | Text = 'Button1' 35 | Width = 80.000000000000000000 36 | OnClick = Button1Click 37 | end 38 | object PaintBox1: TPaintBox 39 | Height = 128.000000000000000000 40 | Position.X = 8.000000000000000000 41 | Position.Y = 8.000000000000000000 42 | Width = 128.000000000000000000 43 | OnPaint = PaintBox1Paint 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /FMDemo/Main.pas: -------------------------------------------------------------------------------- 1 | unit Main; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Objects, FMX.Layouts, FMX.Memo, AsciiImage; 9 | 10 | type 11 | TForm2 = class(TForm) 12 | Memo1: TMemo; 13 | Button1: TButton; 14 | PaintBox1: TPaintBox; 15 | procedure FormCreate(Sender: TObject); 16 | procedure FormDestroy(Sender: TObject); 17 | procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas); 18 | procedure Button1Click(Sender: TObject); 19 | private 20 | { Private-Deklarationen } 21 | FImage: TAsciiImage; 22 | public 23 | { Public-Deklarationen } 24 | end; 25 | 26 | var 27 | Form2: TForm2; 28 | 29 | implementation 30 | 31 | {$R *.fmx} 32 | 33 | const 34 | CEllipsis: array[0..4] of string = 35 | ( 36 | '. . . . .', 37 | '. 1 . 1 .', 38 | '. . . . .', 39 | '. 1 . 1 .', 40 | '. . . . .' 41 | ); 42 | 43 | procedure TForm2.Button1Click(Sender: TObject); 44 | begin 45 | Memo1.Lines.LoadFromFile('E:\Git\AsciiImage\Demo\Debug\Win32\fixture10.txt'); 46 | FImage.LoadFromAscii(Memo1.Lines.ToStringArray); 47 | FImage.OnDraw := procedure(const AIndex: Integer; var AContext: TAsciiImagePaintContext) 48 | begin 49 | AContext.FillColor := TAlphaColorRec.Black; 50 | AContext.StrokeColor := TAlphaColorRec.Black; 51 | if (AIndex <> 1) then 52 | begin 53 | AContext.FillColor := TAlphaColorRec.White; 54 | if AIndex > 1 then 55 | AContext.StrokeColor := TAlphaColorRec.White;; 56 | end; 57 | end; 58 | PaintBox1.Repaint(); 59 | end; 60 | 61 | procedure TForm2.FormCreate(Sender: TObject); 62 | begin 63 | FImage := TAsciiImage.Create(); 64 | end; 65 | 66 | procedure TForm2.FormDestroy(Sender: TObject); 67 | begin 68 | FreeAndNil(FImage); 69 | end; 70 | 71 | procedure TForm2.PaintBox1Paint(Sender: TObject; Canvas: TCanvas); 72 | begin 73 | FImage.Draw(Canvas, Rect(0, 0, Round(PaintBox1.Width), Round(PaintBox1.Height))); 74 | end; 75 | 76 | end. 77 | -------------------------------------------------------------------------------- /License: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Alexander Benikowski 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Memnarch/AsciiImage/6414f5afd1bfe1e1d21e9b004e034d1481b1cff9/Logo.jpg -------------------------------------------------------------------------------- /Packages/AsciiImageDesign.rc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Memnarch/AsciiImage/6414f5afd1bfe1e1d21e9b004e034d1481b1cff9/Packages/AsciiImageDesign.rc -------------------------------------------------------------------------------- /Packages/DelphiXE/AsciiImageDesign.dpk: -------------------------------------------------------------------------------- 1 | package AsciiImageDesign; 2 | 3 | {$R *.res} 4 | {$ALIGN 8} 5 | {$ASSERTIONS ON} 6 | {$BOOLEVAL OFF} 7 | {$DEBUGINFO ON} 8 | {$EXTENDEDSYNTAX ON} 9 | {$IMPORTEDDATA ON} 10 | {$IOCHECKS ON} 11 | {$LOCALSYMBOLS ON} 12 | {$LONGSTRINGS ON} 13 | {$OPENSTRINGS ON} 14 | {$OPTIMIZATION ON} 15 | {$OVERFLOWCHECKS OFF} 16 | {$RANGECHECKS OFF} 17 | {$REFERENCEINFO ON} 18 | {$SAFEDIVIDE OFF} 19 | {$STACKFRAMES OFF} 20 | {$TYPEDADDRESS OFF} 21 | {$VARSTRINGCHECKS ON} 22 | {$WRITEABLECONST OFF} 23 | {$MINENUMSIZE 1} 24 | {$IMAGEBASE $400000} 25 | {$DESIGNONLY} 26 | {$IMPLICITBUILD ON} 27 | 28 | requires 29 | rtl, 30 | vcl; 31 | 32 | contains 33 | AsciiImage in '..\..\AsciiImage.pas', 34 | AsciiImage.RenderContext.Factory in '..\..\AsciiImage.RenderContext.Factory.pas', 35 | AsciiImage.RenderContext.GDI in '..\..\AsciiImage.RenderContext.GDI.pas', 36 | AsciiImage.RenderContext.Intf in '..\..\AsciiImage.RenderContext.Intf.pas', 37 | AsciiImage.RenderContext in '..\..\AsciiImage.RenderContext.pas', 38 | AsciiImage.RenderContext.Types in '..\..\AsciiImage.RenderContext.Types.pas', 39 | AsciiImage.Shapes in '..\..\AsciiImage.Shapes.pas'; 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /Packages/DelphiXE/AsciiImageDesign.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {D7E15AD1-2DF4-43D1-9D43-D8F29CF72DB9} 4 | AsciiImageDesign.dpk 5 | 12.3 6 | True 7 | Debug 8 | Win32 9 | Package 10 | VCL 11 | DCC32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | true 29 | .\$(Config)\$(Platform) 30 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) 31 | 00400000 32 | false 33 | false 34 | true 35 | false 36 | false 37 | false 38 | 39 | 40 | DEBUG;$(DCC_Define) 41 | false 42 | true 43 | 44 | 45 | false 46 | RELEASE;$(DCC_Define) 47 | 0 48 | false 49 | 50 | 51 | 52 | MainSource 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 |
AsciiImageDesign.res
65 | 66 | 67 | Cfg_2 68 | Base 69 | 70 | 71 | Base 72 | 73 | 74 | Cfg_1 75 | Base 76 | 77 | 78 | 79 | 80 | 81 | Delphi.Personality.12 82 | Package 83 | 84 | 85 | 86 | AsciiImageDesign.dpk 87 | 88 | 89 | True 90 | False 91 | 1 92 | 0 93 | 0 94 | 0 95 | False 96 | False 97 | False 98 | False 99 | False 100 | 1031 101 | 1252 102 | 103 | 104 | 105 | 106 | 1.0.0.0 107 | 108 | 109 | 110 | 111 | 112 | 1.0.0.0 113 | 114 | 115 | 116 | Microsoft Office 2000 Sample Automation Server Wrapper Components 117 | Microsoft Office XP Sample Automation Server Wrapper Components 118 | 119 | 120 | 121 | True 122 | 123 | 124 | 12 125 | 126 | 127 | -------------------------------------------------------------------------------- /Packages/DelphiXE6/AsciiImageDesign.dpk: -------------------------------------------------------------------------------- 1 | package AsciiImageDesign; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$DESCRIPTION 'AsciiImage DesigntimePackage'} 29 | {$DESIGNONLY} 30 | {$IMPLICITBUILD ON} 31 | 32 | requires 33 | rtl, 34 | vcl; 35 | 36 | contains 37 | AsciiImage in '..\..\AsciiImage.pas', 38 | AsciiImage.RenderContext.GDI in '..\..\AsciiImage.RenderContext.GDI.pas', 39 | AsciiImage.RenderContext.Intf in '..\..\AsciiImage.RenderContext.Intf.pas', 40 | AsciiImage.RenderContext in '..\..\AsciiImage.RenderContext.pas', 41 | AsciiImage.RenderContext.Types in '..\..\AsciiImage.RenderContext.Types.pas', 42 | AsciiImage.Shapes in '..\..\AsciiImage.Shapes.pas', 43 | AsciiImage.RenderContext.Factory in '..\..\AsciiImage.RenderContext.Factory.pas'; 44 | 45 | end. 46 | -------------------------------------------------------------------------------- /Packages/DelphiXE6/AsciiImageDesign.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {3DA728D3-83ED-4704-9D47-C8EBD071D2DF} 4 | AsciiImageDesign.dpk 5 | 15.4 6 | True 7 | Debug 8 | Package 9 | VCL 10 | DCC32 11 | 1 12 | Win32 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Cfg_1 35 | true 36 | true 37 | 38 | 39 | true 40 | Base 41 | true 42 | 43 | 44 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 45 | 1031 46 | AsciiImageDesign 47 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 48 | true 49 | true 50 | true 51 | .\$(Config)\$(Platform) 52 | false 53 | false 54 | 00400000 55 | false 56 | AsciiImage DesigntimePackage 57 | false 58 | false 59 | true 60 | 61 | 62 | 1033 63 | true 64 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 65 | rtl;vcl;$(DCC_UsePackage) 66 | 67 | 68 | rtl;vcl;$(DCC_UsePackage) 69 | 70 | 71 | DEBUG;$(DCC_Define) 72 | true 73 | false 74 | 75 | 76 | 1033 77 | 78 | 79 | RELEASE;$(DCC_Define) 80 | 0 81 | false 82 | 0 83 | 84 | 85 | 86 | MainSource 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 |
AsciiImageDesign.res
99 | 100 | 101 | Cfg_2 102 | Base 103 | 104 | 105 | Base 106 | 107 | 108 | Cfg_1 109 | Base 110 | 111 | 112 | 113 | 114 | 115 | Delphi.Personality.12 116 | Package 117 | 118 | 119 | 120 | AsciiImageDesign.dpk 121 | 122 | 123 | True 124 | False 125 | 1 126 | 0 127 | 0 128 | 0 129 | False 130 | False 131 | False 132 | False 133 | False 134 | 1031 135 | 1252 136 | 137 | 138 | 139 | 140 | 1.0.0.0 141 | 142 | 143 | 144 | 145 | 146 | 1.0.0.0 147 | 148 | 149 | 150 | Microsoft Office 2000 Sample Automation Server Wrapper Components 151 | Microsoft Office XP Sample Automation Server Wrapper Components 152 | 153 | 154 | 155 | True 156 | False 157 | 158 | 159 | 12 160 | 161 | 162 | -------------------------------------------------------------------------------- /ReadMe.txt: -------------------------------------------------------------------------------- 1 | This is an AsciiImage-Implementation for Delphi by Alexander Benikowski based on AsciiImage by Charles Parnot 2 | Read more on his Article: 3 | http://cocoamine.net/blog/2015/03/20/replacing-photoshop-with-nsstring/ 4 | 5 | Additional: 6 | Delphinus-Support --------------------------------------------------------------------------------