mbmainform.pas

最棒的三大计算机视觉、图像图形函数库之一

unit mbMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, StdCtrls, FreeBitmap;

type
  TMainForm = class(TForm)
    ToolBar: TToolBar;
    tbLoad: TToolButton;
    ToolButton1: TToolButton;
    tbClose: TToolButton;
    ToolButton2: TToolButton;
    cbPages: TComboBox;
    Label1: TLabel;
    OD: TOpenDialog;
    procedure tbLoadClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure tbCloseClick(Sender: TObject);
    procedure cbPagesChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    FMultiBitmap: TFreeMultiBitmap;
    FPage: TFreeWinBitmap;

    procedure PageBitmapChangeHandler(Sender: TObject);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure OpenMultiBitmap(const FileName: string);
    procedure CloseMultiBitmap;
    procedure OpenPage(Number: Integer);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TMainForm }

procedure TMainForm.CloseMultiBitmap;
begin
  if FPage.IsValid then
    FMultiBitmap.UnlockPage(Fpage, False);
  FMultiBitmap.Close;
  cbPages.Clear;
end;

constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited;
  FMultiBitmap := TFreeMultiBitmap.Create;
  FPage := TFreeWinBitmap.Create;
  FPage.OnChange := PageBitmapChangeHandler;
end;

destructor TMainForm.Destroy;
begin
  if FMultiBitmap.IsValid then
    CloseMultiBitmap;
  FMultiBitmap.Free;
  inherited;
end;

procedure TMainForm.OpenMultiBitmap(const FileName: string);
var
  I, Cnt: Integer;
begin
  if FMultiBitmap.IsValid then CloseMultiBitmap;

  FMultiBitmap.Open(FileName, False, True);

  Cnt := FMultiBitmap.GetPageCount;
  cbPages.OnChange := nil;
  cbPages.Clear;
  for I := 0 to Cnt - 1 do
    cbPages.Items.Add(IntToStr(I));
  cbPages.OnChange := cbPagesChange;
end;

procedure TMainForm.OpenPage(Number: Integer);
begin
  if not FMultiBitmap.IsValid then Exit;

  if FPage.IsValid then
    FMultiBitmap.UnlockPage(FPage, False);

  FMultiBitmap.LockPage(Number, FPage);
end;

procedure TMainForm.PageBitmapChangeHandler(Sender: TObject);
begin
  Invalidate;
end;

procedure TMainForm.tbLoadClick(Sender: TObject);
begin
  if OD.Execute then
  begin
    try
      OpenMultiBitmap(OD.FileName);
    except
      raise Exception.CreateFmt('Can not load file %s', [OD.FileName]);
    end;
  end;
end;

procedure TMainForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
  if not FPage.IsValid then
  begin
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(ClientRect);
  end
  else
    FPage.Draw(Canvas.Handle, ClientRect);
end;

procedure TMainForm.tbCloseClick(Sender: TObject);
begin
  if FMultiBitmap.IsValid then
    CloseMultiBitmap;
end;

procedure TMainForm.cbPagesChange(Sender: TObject);
var
  Page: Integer;
begin
  Page := StrToInt(cbPages.Text);
  OpenPage(Page);
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.