unit VisualForm;

interface


uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, Buttons, ComCtrls;

type
 TfmMain = class(TForm)
 Panel1: TPanel;
 Panel2: TPanel;
 pbDraw: TPaintBox;
 Timer1: TTimer;
 Label1: TLabel;
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 procedure FormResize(Sender: TObject);
 procedure Timer1Timer(Sender: TObject);
 private
 { Private declarations }
 procedure CreateBitmap(aSX, aSY: Integer);
 procedure RecreateBitmap(aSX, aSY: Integer);
 procedure DeleteBitmap;

 procedure RestrictSize(var msg: TMessage); message WM_GETMINMAXINFO;
 procedure pbDrawPaint(Sender: TObject);
 private
 ScrBitmap: TBitmap;
 Scr: Pointer;
 SX, SY: Integer;
 public
 { Public declarations }
 end;

var
 fmMain: TfmMain;

implementation

{$R *.DFM}

type
 TBig = array[0..0] of Integer;

procedure TfmMain.CreateBitmap(aSX, aSY: Integer);
var
 BInfo: tagBITMAPINFO;
begin
 // Создание DIB
 SX := aSX; SY := aSY;
 BInfo.bmiHeader.biSize := sizeof(tagBITMAPINFOHEADER);
 BInfo.bmiHeader.biWidth := SX;
 BInfo.bmiHeader.biHeight := -SY;
 BInfo.bmiHeader.biPlanes := 1;
 BInfo.bmiHeader.biBitCount := 32;
 BInfo.bmiHeader.biCompression := BI_RGB;
 ScrBitmap := TBitmap.Create();
 ScrBitmap.Handle := CreateDIBSection(Canvas.Handle, BInfo, DIB_RGB_COLORS, Scr, 0, 0);
 ZeroMemory(Scr, SX * SY * 4);
end;

procedure TfmMain.DeleteBitmap;
begin
 // Удаление DIB
 ScrBitmap.FreeImage();
 ScrBitmap.Destroy;
end;

procedure TfmMain.RecreateBitmap(aSX, aSY: Integer);
var
 BInfo: tagBITMAPINFO;
begin
 // Пересоздание DIB при изменении размеров "экрана"
 ScrBitmap.FreeImage();
 SX := aSX; SY := aSY;
 BInfo.bmiHeader.biSize := sizeof(tagBITMAPINFOHEADER);
 BInfo.bmiHeader.biWidth := SX;
 BInfo.bmiHeader.biHeight := -SY;
 BInfo.bmiHeader.biPlanes := 1;
 BInfo.bmiHeader.biBitCount := 32;
 BInfo.bmiHeader.biCompression := BI_RGB;
 ScrBitmap.Handle := CreateDIBSection(Canvas.Handle, BInfo, DIB_RGB_COLORS, Scr, 0, 0);
 ZeroMemory(Scr, SX * SY * 4);
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
 CreateBitmap(pbDraw.ClientWidth, pbDraw.ClientHeight);
 pbDraw.Canvas.Draw(0, 0, ScrBitmap);
 Caption := 'Визуализатор'; Application.Title := Caption;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
 DeleteBitmap();
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
 ReCreateBitmap(pbDraw.ClientWidth, pbDraw.ClientHeight);
 pbDraw.Canvas.Draw(0, 0, ScrBitmap);
end;

procedure TfmMain.RestrictSize(var msg: TMessage);
var
 p: PMinMaxInfo;
begin
 // Ограничитель размеров окна (обработка сообщений Windows).
 // Удобная вещь кстати (важно: см. объявление процедуры в классе TFmMain)
 // The lParam contains a pointer on a structure of type TMinMaxInfo
 p := PMinMaxInfo(Msg.lParam);
 // This represents the size of the Window when Maximized
// p.ptMaxSize.x := 320;
// p.ptMaxSize.y := 240;
 // This represents the position of the Window when Maximized
// p.ptMaxPosition.x := 10;
// p.ptMaxPosition.y := 10;
 // This represents the minimum size of the Window
 p.ptMinTrackSize.x := 520;
 p.ptMinTrackSize.y := 240;
 // This represents the maximum size of the Window
// p.ptMaxTrackSize.x := 400;
// p.ptMaxTrackSize.y := 320;
end;

procedure TfmMain.pbDrawPaint(Sender: TObject);
begin
 pbDraw.Canvas.Draw(0, 0, ScrBitmap);
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
var
 x, y: Integer;

begin
 // В цикле рисуется полная левота. Рисуйте тут свою левоту :)
 for x := 0 to SX - 1 do for y := 0 to SY - 1 do
 TBig(Scr^)[x + y * SX] := RGB(Random(256),Random(256),Random(256));

 // При желании, используем средства Delphi на объекте ScrBitmap типа TBitmap
 // в т.ч. можно нарисовать на нем другой Bitmap с помощью функции
 // ScrBitmap.Canvas.Draw(x,y,AnotherBitmap);
 // Чтобы текст выглядел красивее (без фона), раскомментируйте строки
 // SetBkMode(ScrBitmap.Canvas.Handle, TRANSPARENT);
 ScrBitmap.Canvas.Font.Size := 24;
 ScrBitmap.Canvas.TextOut(10, 10, 'Demo');
 // SetBkMode(ScrBitmap.Canvas.Handle, OPAQUE);

 // Нарисуемся
 pbDrawPaint(Self);
end;

end.