main.pas

一个酒店房间图片介绍的小软件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,setfrm,jpeg;

CONST
   imagewidth=160;

type
  roomarray=array[1..50] of string;
  imgnarray=array[1..50] of integer;
  TForm1 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    ListBox1: TListBox;
    ScrollBox2: TScrollBox;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);

    procedure OnCreat(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure imageonclick(Sender: TObject);
    procedure Onactivate(Sender: TObject);
    procedure Onresize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure onmousemove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Timer2Timer(Sender: TObject);
    procedure Ondestroy(Sender: TObject);
    procedure onclose(Sender: TObject; var Action: TCloseAction);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Room:roomArray;
  imgnumber:imgnarray;
  n:integer;
  workpath:string;
  welcomeword:string;
  filepath:string;
  imgpanel:array[1..30] of TPanel;
  smlimage:array[1..30] of TImage;
  smlbitmap:array[1..30] of TBitmap;
  selected:integer;
  diridx:integer;
  timecount,imagenum:integer;
  sysfont:Tfont;
  
procedure readroom(infilename:string;var n:integer;var sysfont:Tfont;var welcomeword:string;var room:roomArray;var imgnumber:imgnarray);
procedure writeroom(outfilename:string;n:integer;var sysfont:Tfont;var welcomeword:string;var room:roomarray;var imgnumber:imgnarray);
procedure displayimg(t:integer);
implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
   form2.Show;
   Form1.OnCreat(sender);
end;


procedure TForm1.OnCreat(Sender: TObject);
var
  //filepath:string;

  i:integer;
begin
 listbox1.Clear;
 sysfont:=Tfont.Create;
  imagenum:=0;
  scrollbox1.DoubleBuffered:=true;  //减少文字移动时的闪烁
  workpath:=getCurrentDir;
  filepath:=workpath+'\data.dat';
  if FileExists(filepath) then
  readroom(filepath,n,sysfont,welcomeword,room,imgnumber)
  else
  begin
   welcomeword:='欢迎使用酒店房间介绍系统';
   sysfont.Size:=40;
   sysfont.Color:=clred;
  writeroom(filepath,0,sysfont,welcomeword,room,imgnumber);
  end;
   if n>0 then
   begin
   for i:=1 to n do
   listbox1.Items.Add(room[i]);

   end;
   label2.Font.Size:=sysfont.Size;

   label2.Font.Color:=sysfont.Color;
  label2.Caption:=welcomeword;
   label2.Left:=(scrollbox1.Width-length(welcomeword)*20) div 2;
  //label2.Width:=length(welcomeword)*28;
  label2.Top:= trunc(scrollbox1.Height/2)-50;
  label2.Visible:=false;
end;

procedure readroom(infilename:string;var n:integer;var sysfont:Tfont;var welcomeword:string;var room:roomArray;var imgnumber:imgnarray);
var
    InF  : Text;     { Input file }
    //Nvar : Integer;  { Number of variables }
    i    : Integer;  { Loop variable }
    temp:longint;
begin
    Assign(InF, infilename);
    Reset(InF);

    //ReadLn(InF, Title);

     ReadLn(InF, N);
      ReadLn(InF, welcomeword);

     ReadLn(InF, i);
      sysfont.size:=i;

      ReadLn(InF, temp);
      sysfont.color:=temp;
    if n<>0 then
    begin
    for i:=1 to n do
    begin
     readln(inf,room[i]);
     readln(inf,imgnumber[i]);
     end;
   end;
  Close(InF);
   // ReadInputFile := 0;

end;

procedure writeroom(outfilename:string;n:integer;var sysfont:Tfont;var welcomeword:string;var room:roomarray;var imgnumber:imgnarray);
var
   OutF     : Text;
   i:integer;
   temp:longint;
begin
  Assign(OutF, outfilename);
    Rewrite(OutF);
     WriteLn(OutF, n);
     WriteLn(OutF, welcomeword);
     temp:=sysfont.size;
     WriteLn(OutF, temp);
     temp:=sysfont.color;
     WriteLn(OutF, temp);
     if n<>0 then
    begin
    for i:=1 to n do
    begin
     WriteLn(OutF ,room[i]);
     WriteLn(OutF ,imgnumber[i]);
     end;
   end;
   Close(OutF);

end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  i,j,k:integer;
  found:integer;
  sr:TSearchRec;
  temp,dirname:string;
   ajpeg:Tjpegimage;
   w,h:integer;
   fbitmap:TBitmap;

begin
 selected:=0;
 ajpeg:=Tjpegimage.Create;
 fbitmap:=Tbitmap.Create;

  fbitmap.PixelFormat:=pf24bit;

  if imagenum>0 then
  for i:=1 to imagenum do
  begin
  smlimage[i].Free;
  smlbitmap[i].Free;
  imgpanel[i].Free;
  end;
  i:=1;
  
  k:=listbox1.ItemIndex;
  if k>=0 then
  begin
  dirname:=room[k+1];
  diridx:=k+1;
  temp:=workpath+'\'+dirname+'\*.*';
Found := FindFirst(temp, faArchive, sr);
     while Found = 0 do
     begin
     temp:=workpath+'\'+dirname+'\'+sr.Name;
     // fbitmap:=LoadThumb(temp);
     ajpeg.LoadFromFile(temp);

     //ajpeg.Scale:=jsEighth;
      ajpeg.Scale:=jsQuarter;
      fbitmap.Assign(ajpeg);
     w:=ajpeg.Width;
     h:=ajpeg.Height;
     imgpanel[i]:=TPanel.Create(form1.scrollbox2);
     imgpanel[i].Enabled := True;
    imgpanel[i].parent  := form1.scrollbox2;
     imgpanel[i].Width:=imagewidth;
     imgpanel[i].Height:=imagewidth;

       imgpanel[i].top     := (i - 1) * imagewidth;
     imgpanel[i].Left:=0;
     imgpanel[i].Tag:=i+50;
     imgpanel[i].OnClick:=form1.imageonclick;



     smlimage[i]         := TImage.Create(imgpanel[i]);
     smlbitmap[i]:=Tbitmap.Create;
     smlbitmap[i].PixelFormat:=pf24bit;
    smlimage[i].Enabled := True;
    smlimage[i].parent  := imgpanel[i];
    smlimage[i].Tag     :=  i;
    smlimage[i].Visible := True;
    smlimage[i].OnMouseMove:=Form1.onmousemove;

    //smlimage[i].top     := (i - 1) * imagewidth;

    if w>h then
     begin
     smlimage[i].Width :=imagewidth;
     smlimage[i].Height:=trunc(imagewidth/w*h);
     end
     else
     begin
     smlimage[i].Height:=imagewidth;
     smlimage[i].Width:=trunc(imagewidth/h*w);
     end;
      smlimage[i].top     := trunc((imagewidth- smlimage[i].Height)/2);
      smlimage[i].Left    := trunc((imagewidth- smlimage[i].Width)/2);
     smlbitmap[i].Width:=smlimage[i].Width;
     smlbitmap[i].Height:=smlimage[i].Height;

     smlbitmap[i].Canvas.StretchDraw(rect(0,0,smlimage[i].Width,smlimage[i].Height),fbitmap);
    smlimage[i].Stretch:=true;
    smlimage[i].OnClick :=Form1.imageonclick;
  //StretchBlt(sbitmap.Canvas.Handle,0,0,smlimage[i].Width,smlimage[i].Height,fbitmap.Canvas.Handle,0,0,w,h,srccopy);
   //smlimage[i].Picture.Assign(fbitmap);
     smlimage[i].Canvas.Draw(0,0,smlbitmap[i]);


     inc (i);

     Found := FindNext(sr);
     end;
     imagenum:=i-1;
     FindClose(sr);
   end;
  // sbitmap.Free;
    fbitmap.Free;
   ajpeg.Free;

end;




procedure TForm1.imageonclick(Sender: TObject);
var
  t,w,h,i:integer;

begin
  //ShowMessage(IntToStr(Timage(Sender).tag));
  if (sender is Timage) then
  t:=Timage(Sender).tag
  else
  t:=Tpanel(sender).Tag-50;
  w:= smlimage[t].Picture.Width;
  h:= smlimage[t].Picture.Height;

  smlimage[t].Canvas.Pen.Color:=clblue;
   smlimage[t].Canvas.Pen.Width:=2;
   smlimage[t].Canvas.Pen.Style:=psSolid;
   smlimage[t].Canvas.Brush.Style:=bsclear;
   for i:= 1 to imagenum do
//  smlimage[i].Canvas.Draw(0,0,smlbitmap[i]);
  imgpanel[i].Color:=clBtnFace;
 // smlimage[t].Canvas.Rectangle(1,1,imagewidth-1,imagewidth-1);
   imgpanel[t].Color:=clskyblue;
   selected:=t;
   displayimg(t);

end;

procedure displayimg(t:integer);
var
  i,j,k:integer;
  found:integer;
  sr:TSearchRec;
  temp,dirname:string;
   ajpeg:Tjpegimage;
   w,h,w1,h1:integer;
   fbitmap,sbitmap:TBitmap;
begin
//

dirname:=room[diridx];
ajpeg:=Tjpegimage.Create;
 fbitmap:=Tbitmap.Create;
 sbitmap:=Tbitmap.Create;
 fbitmap.PixelFormat:=pf24bit;
 sbitmap.PixelFormat:=pf24bit;
 if t=99 then
 temp:=workpath+'\welcome.jpg'
 else
 temp:=workpath+'\'+dirname+'\'+inttostr(t)+'.jpg';
  if fileexists(temp) then
  begin
  ajpeg.LoadFromFile(temp);


  fbitmap.Assign(ajpeg);
  w:=ajpeg.Width;
  h:=ajpeg.Height;
  if (w/form1.ScrollBox1.Width) > (h/form1.ScrollBox1.Height) then
  begin
  w1:=form1.ScrollBox1.Width;
  h1:=trunc(w1/w*h);
  end
  else
  begin
   h1:=form1.ScrollBox1.Height;
  w1:=trunc(h1/h*w);
  end;

  form1.Image1.Top:=trunc((form1.ScrollBox1.Height-h1)/2);
  form1.Image1.Left:=trunc((form1.ScrollBox1.Width-w1)/2);
  form1.Image1.Width:=w1;
  form1.Image1.Height:=h1;
  sbitmap.Width:= w1;
  sbitmap.Height:=h1;
  sbitmap.Canvas.StretchDraw(rect(0,0,w1,h1),fbitmap);
  form1.Image1.Picture.Graphic:=sbitmap;
   //form1.Image1.Canvas.FillRect(rect(0,0,form1.Image1.Width,form1.Image1.Height));
  // form1.Image1.Canvas.CopyMode:=cmSrcCopy		;
  //form1.Image1.Canvas.CopyRect(rect(0,0,w1,h1),sbitmap.Canvas,rect(0,0,w1,h1));
  // form1.Image1.Canvas.draw(0,0,sbitmap);

 // form1.Image1.Picture.Assign( ajpeg);
  end;
  sbitmap.Free;
  fbitmap.Free;
   ajpeg.Free;

end;

procedure TForm1.Onactivate(Sender: TObject);
begin
  //imagenum:=0;
end;

procedure TForm1.Onresize(Sender: TObject);
begin
if selected>0 then
displayimg(selected);
 label2.Left:=(scrollbox1.Width-length(welcomeword)*20) div 2;
  //label2.Width:=length(welcomeword)*28;
  label2.Top:= trunc(scrollbox1.Height/2)-50;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
temp:integer;
begin
temp:=sysfont.Size;
label2.Font.Color:=sysfont.Color;
label2.Font.Size:=sysfont.Size;
label2.Transparent:=true;
if label2.Left<-4*temp then
begin
label2.Left:=scrollbox1.Width;
 //form1.image1.Canvas.Brush.Style:=bsClear;
//form1.image1.Canvas.TextOut(0,0,welcomeword)
end
else
label2.Left:=label2.Left-22;
{if label2.Visible then
label2.Visible:=false
else
label2.Visible:=true; }

end;

procedure TForm1.onmousemove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
timecount:=0;
timer1.Enabled:=false;
label2.Visible:=false;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin

timecount:=timecount+1;
if timecount>3 then
begin
displayimg(99);
timer1.Enabled:=true;
label2.Visible:=true;
end;
end;

procedure TForm1.Ondestroy(Sender: TObject);
begin
sysfont.Free;
end;

procedure TForm1.onclose(Sender: TObject; var Action: TCloseAction);
begin
 //sysfont.Free;
end;

end.