dibpbox.pas

Delphi Dib usage components. These ise a dib-paintbox... u can use them. :>)

unit DIBpbox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DIBSurf;

type
  TDIBPaintBox = class(TControl)
  private
    { Private declarations }
    FDIBsurface   : TDIBSurface;
    FCanvas    : TCanvas;
  //  FDIBCanvas : TCanvas;
    FOnPaint: TNotifyEvent;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure Paint; virtual;
    property  Canvas: TCanvas read FCanvas;
//    property  DIBCanvas : TCanvas read FDIBCanvas;
    property  DIBSurface : TDIBSurface read FDIBSurface;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    { Published declarations }
    property Align;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TDIBPaintBox]);
end;

procedure TDIBPaintBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
   w, h : integer;
begin
     w := Width;
     h := Height;
     inherited SetBounds(ALeft, ATop, AWidth, AHeight);
     if (w<>AWidth) or (h<>AHeight) then
     begin
        FDIBSurface.Resize(AWidth,AHeight);
//        FDIBCanvas.Handle := FDibSurface.Handle;
     end;
end;

procedure TDIBPaintBox.WMPaint(var Message: TWMPaint);
begin
  if Message.DC <> 0 then
  begin
    Canvas.Handle := Message.DC;
    try
      Paint;
    finally
      Canvas.Handle := 0;
    end;
  end;
end;

procedure TDIBPaintBox.Paint;
var
   OldPal : HPALETTE;
begin
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  if Assigned(FOnPaint) then FOnPaint(Self);
  OldPal := SelectPalette(Canvas.Handle,FDIBSurface.Palette.Handle,False);
  BitBlt(Canvas.Handle,0,0,Width,Height,FDIBSurface.Handle,0,0,SRCCOPY);
  SelectPalette(Canvas.Handle,OldPal,False);
end;

constructor TDIBPaintBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  ControlStyle := ControlStyle + [csReplicatable];
  (******* DIB *******)
   FDibSurface := TDIBSurface.Create(4,4);
   FDibSurface.Clear;
//   FDIBCanvas  := TCanvas.Create;
//   FDIBCanvas.Handle := FDibSurface.Handle;

   Width := 105;
   Height := 105;
end;

destructor TDIBPaintBox.Destroy;
begin
 // FDIBCanvas.Free;
  FDIBSurface.Free;
  FCanvas.Free;
  inherited Destroy;
end;

end.