[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

{...}

[lbccaleb]

Das so ähnlich wie diese Unit von der Seite:

NonVCL Canvas

Oder?

Auf jedenfall kann man sowas immer mal gebrauchen, ja
Danke dafür...

PS: währe es schlimm für dich den bsp. Code deines Programms auch noch mit anzuhängen?
Um mal zu sehen wie es genau funzt?
Wofür ist die andere Unit, die oben unter Uses steht? Brauch man die auch?

Edit:
Aso, gerade gesehen ist per Compilerschalter ausgeschaltet...