[nonVCL] Graphics- Unit Lite

[turboPASCAL]

Hi,

ich habe gerade eine kleine Unit for nonVCL zusammen gebastelt, um mir den Umgang
bei dem Zeichnen von Graphiken zu erleichtern.

Wer's brauch oder gebrauchen kann, bitte:

Delphi-Quellcode:

{*******************[        uNVCLGraphics for nonVCL        ]*****************}
{                                  Version 1.0                                 }
{                                                                              }
{               __                                                             }
{   ...by      / /_____                                                        }
{            / __/ __ \                                                        }
{           / /_/ /_/ /                                                        }
{          \__/  ___/                                                          }
{            /_/          turboPASCAL (tp) aka MatthiasG.                      }
{                                Member of [url]www.delphipraxis.net[/url]                }
{                                                                              }
{*********************************[    2009    ]*******************************}

unit uNVCLGraphics; {Lite}

{.$DEFINE USE_IMAGES}
{.$DEFINE NON_VCL_TOOLS_UNIT}

interface

{$IFDEF NON_VCL_TOOLS_UNIT}
uses
  Windows
  nonVCLTools;
{$ELSE}
uses
  Windows;
{$ENDIF}

const
  clBlack  = $00000000;
  clWhite  = $00FFFFFF;
 
  clLGray  = $00808080;
  clGray   = $00C0C0C0;
  clDGray  = $00404040;

  clRed    = $000000FF;
  clLRed   = $008080FF;
  clDRed   = $00000080;

  clGreen  = $0000FF00;
  clLGreen = $0080FF80;
  clDGreen = $00008000;

  clBlue   = $00FF0000;
  clLBlue  = $00FF8080;
  clDBlue  = $00800000;

  clYellow  = $0000FFFF;
  clDYellow = $00004040;


type
  TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear);

  TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
  TFontStyles = set of TFontStyle;

type
  TPen = class
  private
    DC: HDC;
    penColor: Cardinal;
    penStyle: TPenStyle;
    penWidth: integer;
    procedure ReCreate;
    procedure SetPenStyle(Style: TPenStyle);
    procedure SetPenWidth(Width: integer);
    procedure SetPenColor(Color: Cardinal);
  public
    Handle: HPEN;
    constructor Create(DCHandle: HDC);
    destructor Destroy; override;

    property Color: Cardinal read penColor write SetPenColor;
    property Style: TPenStyle read penStyle write SetPenStyle;
    property Width: integer read penWidth write SetPenWidth;
  end;

  TBrush = class
  private
    DC: HDC;
    brushColor: Cardinal;
    procedure ReCreate;
  public
    Handle: HBRUSH;
    constructor Create(DCHandle: HDC);
    destructor Destroy; override;
    procedure SetColor(Color: Cardinal);

    property Color: Cardinal read brushColor write SetColor;
  end;

  TFont = class
  private
    DC: HDC;
    fontName: string;
    fontSize: integer;
    fontStyle: TFontStyles;
    fontColor: Cardinal;
    fontOrientation: integer;
    lf: TLogFont;
    procedure SetName(Name: string);
    procedure SetSize(Size: integer);
    procedure SetStyle(Style: TFontStyles);
    procedure SetColor(Color: Cardinal);
    procedure SetOrientation(Orientation: integer);

    procedure ReCreate;
  public
    Handle: HFONT;
    constructor Create(DCHandle: HDC);
    destructor Destroy; override;

    property Name: string read fontName write SetName;
    property Size: integer read fontSize write SetSize;
    property Color: Cardinal read fontColor write SetColor;
    property Style: TFontStyles read fontStyle write SetStyle;
    property Orientation: integer read fontOrientation write SetOrientation;
  end;

type
  TGraphic = class
  private
    Wnd: HWND;
    gDC: HDC;
    BoundsRect: TRect;

    pBmpBits: pointer;
    BmpInfo: BITMAPINFO;
    hBmp: HBITMAP;
  public
    Pen: TPen;
    Brush: TBrush;
    Font: TFont;
    constructor Create(DCHandle: HDC; WndHandle: HWND; Left, Top, Width, Height: integer);
    destructor Destroy; override;

    function CreateGraphicBitmap(var BmpInfo: BITMAPINFO; const W, H: Integer; out BitmapBits: Pointer): HBITMAP;
    procedure Line(x1, y1, x2, y2: integer);
    procedure FillRect(r: TRect);
    procedure Ellipse(x1, y1, x2, y2: integer);
    procedure RoundRect(x1, y1, x2, y2, r1, r2: integer);
    procedure FrameRect(x1, y1, x2, y2: integer); overload;
    procedure FrameRect(Rect: TRect); overload;
    procedure Rectangle(x1, y1, x2, y2: integer);
    procedure SetPixel(x, y: integer; Color: Cardinal);
    function GetPixel(x, y: integer): Cardinal;
    procedure TextOut(x, y: integer; Text: string);
    procedure DrawTo(DC: HDC; x, y: integer);
    procedure StretchDrawTo(DC: HDC; x1, y1, x2, y2: integer);

    procedure Invalidate(const EraseBackround: Boolean = FALSE);

    {$IFDEF USE_IMAGES}
      procedure LoadImageFromFile(Filename: string);
      procedure LoadImageFromResourceID(Instance: HInst; ResID: Integer);
      procedure LoadImageFromResourceName(Instance: HInst; ResName: PChar);
    {$ENDIF USE_IMAGES}

    // property  Pixels: ... read GetPixels write Cardinal;
    property Bits: Pointer read pBmpBits;
  end;

{$IFNDEF NON_VCL_TOOLS_UNIT}
  function Point(X, Y: Integer): TPoint;
  function Rect(X1, Y1, X2, Y2: Integer): TRECT;
{$ENDIF NON_VCL_TOOLS_UNIT}

implementation

{...}