You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
151 lines
3.1 KiB
151 lines
3.1 KiB
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.
|