久久中文视频-久久中文网-久久中文亚洲国产-久久中文字幕久久久久-亚洲狠狠成人综合网-亚洲狠狠婷婷综合久久久久


曙海教育集團論壇開發(fā)語言培訓(xùn)專區(qū)Delphi程序設(shè)計 → 關(guān)于拉幕程序的討論和源碼


  共有8769人關(guān)注過本帖樹形打印

主題:關(guān)于拉幕程序的討論和源碼

美女呀,離線,留言給我吧!
wangxinxin
  1樓 個性首頁 | 博客 | 信息 | 搜索 | 郵箱 | 主頁 | UC


加好友 發(fā)短信
等級:青蜂俠 帖子:1393 積分:14038 威望:0 精華:0 注冊:2010-11-12 11:08:23
關(guān)于拉幕程序的討論和源碼  發(fā)帖心情 Post By:2010-12-14 11:20:34

  修改后可以使用的程序源代碼(還是不完善:還不能實現(xiàn)從一側(cè)飛入的效果,輕易出錯):
  unitUnit1;
  
  interface
  
  uses
  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
  StdCtrls,ExtCtrls,ComCtrls,ColorGrd,RxCombos;
  
  type
  TForm1=class(TForm)
  Button1:TButton;
  Edit1:TEdit;
  OpenDialog1:TOpenDialog;
  Button2:TButton;
  Button3:TButton;
  TrackBar1:TTrackBar;
  Panel1:TPanel;
  Panel2:TPanel;
  Panel3:TPanel;
  Label1:TLabel;
  Label2:TLabel;
  Timer1:TTimer;
  Button4:TButton;
  ColorDialog1:TColorDialog;
  FontDialog1:TFontDialog;
  Button6:TButton;
  Button7:TButton;
  ComboBox1:TComboBox;
  Panel4:TPanel;
  Edit2:TEdit;
  Edit3:TEdit;
  Label3:TLabel;
  Label4:TLabel;
  Label5:TLabel;
  Label6:TLabel;
  Edit4:TEdit;
  Edit5:TEdit;
  Button8:TButton;
  Button5:TButton;
  procedureButton1Click(Sender:TObject);
  procedureFormCreate(Sender:TObject);
  procedureTimer1Timer(Sender:TObject);
  procedureButton2Click(Sender:TObject);
  procedureButton3Click(Sender:TObject);
  procedureTrackBar1Change(Sender:TObject);
  procedureFormDestroy(Sender:TObject);
  procedureButton4Click(Sender:TObject);
  procedureButton7Click(Sender:TObject);
  procedureButton6Click(Sender:TObject);
  procedureButton8Click(Sender:TObject);
  procedureButton5Click(Sender:TObject);
  private
  procedurezShowText;
  ProcedurezBmpCreate;
  procedurezSetBmp;
  procedurezSetLineHeight;
  procedurezShowLine(sender:TObject);
  {Privatedeclarations}
  public
  {Publicdeclarations}
  end;
  
  var
  Form1:TForm1;
  
  implementation
  
  {$R*.DFM}
  const
  bWidth=200;
  var
  currline,LineHeight:integer;
  sItem:TStringList;
  bmp:TBitMap;
  bRect,R1:TRect;
  iDc:HDC;
  
  procedureTForm1.Button1Click(Sender:TObject);
  begin
  OpenDialog1.Execute;
  Edit1.Text:=OpenDialog1.FileName;
  end;
  
  procedureTForm1.FormCreate(Sender:TObject);
  begin
  Form1.WindowState:=wsMaximized;
  Panel1.Top:=80;
  Panel1.Left:=96;
  Panel1.Height:=385;
  Panel1.Width:=433;
  Timer1.Enabled:=False;
  Label2.Caption:='100';
  iDC:=GetDc(Panel1.handle);
  Currline:=0;
  end;
  
  procedureTForm1.zShowLine(sender:TObject);
  begin
  zShowText;
  end;
  
  procedureTForm1.Timer1Timer(Sender:TObject);
  begin
  zShowLine(self);//顯示字符串
  //bitblt轉(zhuǎn)移矩形圖(目標句柄,LSx,y,寬,高,源句柄,LSx,y,光柵運算符)
  BitBlt(iDc,0,0,Panel1.Width,Panel1.Height,
  Bmp.Canvas.Handle,0,Currline,srcCopy);
  Inc(Currline,1);
  ifCurrline>=bRect.Bottom-panel1.Height 100then//循環(huán)條件?
  begin
  Timer1.Enabled:=False;
  Currline:=0;
  end;
  end;
  
  
  procedureTForm1.zShowText;
  var
  i:integer;
  ss:string;
  ReadFile:TextFile;
  begin
  AssignFile(ReadFile,Edit1.Text);
  Reset(ReadFile);
  i:=1;
  sItem:=TStringList.Create;
  withsItemdo
  whilenoteof(ReadFile)do
  begin
  Readln(ReadFile,ss);
  add(ss);
  i:=i 1;
  end;
  CloseFile(ReadFile);
  zBmpCreate;
  sItem.Free;//釋放串
  end;
  
  procedureTForm1.zBmpCreate;//創(chuàng)建圖片
  var
  i,y:integer;//y
  begin
  ifbmp<>nilthenbmp.free;
  bmp:=TBitMap.Create;
  zSetBmp;
  R1.Right:=bRect.Right;
  R1.Bottom:=bRect.Bottom;
  y:=Panel1.Height-100;
  fori:=0tosItem.Count-1do//從0到行數(shù)循環(huán)顯示圖片
  begin
  R1.Top:=y;
  R1.Bottom:=R1.Top LineHeight;
  ifCombobox1.Text='中間對齊'then//顯示圖片
  DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_CenterorDt_Top)
  else
  ifCombobox1.Text='左對齊'then
  DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_LeftorDt_Top)
  else
  ifCombobox1.Text='右對齊'then
  DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_RightorDt_Top)
  else
  DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_CenterorDt_Top);
  Inc(y,LineHeight);
  end;
  end;
  
  
  
  
  
  procedureTForm1.zSetBmp;
  begin
  zSetLineHeight;
  withbRectdo//Rect矩形坐標(左上x,左下y,右上x,右下y)
  begin
  Top:=0;
  Left:=0;
  Right:=Panel1.Width;
  Bottom:=LineHeight*sItem.Count Height;//行高*行數(shù) form高度
  end;
  withBmpdo
  begin
  Height:=bRect.Bottom 100;//圖片高度
  Width:=bRect.Right;
  withCanvasdo//canvas畫布
  begin
  Font:=FontDialog1.Font;
  //Font:=self.Font;//form所設(shè)置的字體
  Brush.Color:=ColorDialog1.Color;
  FillRect(bRect);
  Brush.Style:=bsClear;
  end;
  end;
  end;
  
  
  
  
  
  procedureTForm1.zSetLineHeight;
  {設(shè)置行間隔}
  var
  Metrics:TTextMetric;//設(shè)置字體API
  begin
  GetTextMetrics(iDc,Metrics);
  LineHeight:=Metrics.tmHeight Metrics.tmInternalLeading-Bmp.Canvas.Font.Height;
  end;
  
  
  
  procedureTForm1.Button2Click(Sender:TObject);
  begin
  ifEdit1.Text='thenShowMessage('請輸入文件地址')
  else
  begin
  ifButton2.Caption='開始'thenButton2.Caption:='暫停'
  elseButton2.Caption:='開始';
  Timer1.Enabled:=notTimer1.Enabled;
  end;
  end;
  
  procedureTForm1.Button3Click(Sender:TObject);
  begin
  timer1.Enabled:=false;
  Currline:=0;
  Button2.Click;
  Button2.Caption:='暫停';
  end;
  
  procedureTForm1.TrackBar1Change(Sender:TObject);
  begin
  Timer1.Interval:=TrackBar1.Position*5;
  Label2.Caption:=inttostr(Timer1.Interval);
  end;
  
  procedureTForm1.FormDestroy(Sender:TObject);
  begin
  ifBmp<>nilthenBmp.Free;
  end;
  
  procedureTForm1.Button4Click(Sender:TObject);
  begin
  close;
  end;
  
  
  procedureTForm1.Button7Click(Sender:TObject);
  begin
  FontDialog1.Execute;
  end;
  
  procedureTForm1.Button6Click(Sender:TObject);
  begin
  ColorDialog1.Execute;
  end;
  
  procedureTForm1.Button8Click(Sender:TObject);
  begin
  if((strtoint(Edit2.Text)>=600)or(strtoint(Edit3.text)>=500)or((strtoint(Edit5.Text)>=553)or(strtoint(Edit4.Text)>=630)))
  thenshowmessage('范圍超界')
  else
  begin
  Panel1.Top:=strtoint(Edit2.text);
  Panel1.Left:=strtoint(Edit3.text);
  Panel1.Width:=strtoint(Edit4.text);
  Panel1.Height:=strtoint(Edit5.text);
  end;
  
  end;
  
  
  
  procedureTForm1.Button5Click(Sender:TObject);
  begin
  Panel1.Top:=0;
  Panel1.Left:=0;
  Panel1.Width:=Panel3.Width;
  Panel1.Height:=Panel3.Height;
  end;
  
  end.
  


支持(0中立(0反對(0單帖管理 | 引用 | 回復(fù) 回到頂部

返回版面帖子列表

關(guān)于拉幕程序的討論和源碼








簽名
主站蜘蛛池模板: 欧美日韩另类视频 | 五月色一区二区亚洲小说 | 男女朋友做爽爽爽免费视频网 | 久久视频免费观看 | 九九精品在线视频 | 国产一级片在线 | 国产成人久久精品 | 国产伦精一区二区三区视频 | 一区二区三区免费观看 | 99久久久免费精品免费 | 免费观看一级特黄欧美大片 | 久久精品亚洲一级毛片 | 国产成人精品aaaa视频一区 | 久久久久久毛片免费观看 | 久久一区二区三区不卡 | 亚洲一区免费在线观看 | 日韩午夜在线视频不卡片 | 日本成年人视频网站 | 一级做a爱片特黄在线观看免费看 | 国产a久久精品一区二区三区 | 日本一区二区三区不卡视频中文字幕 | 欧美国产精品不卡在线观看 | 99免费在线观看 | 中文国产日韩欧美视频 | 亚洲综合干 | 精品视频 九九九 | 99免费在线观看 | 国产午夜精品久久久久九九 | 亚洲第一页在线 | 免费一级片视频 | 一个人看的日本免费视频 | 中文字幕亚洲综合久久男男 | 欧美一级毛片欧美毛片视频 | 不卡午夜视频 | 亚洲欧美国产一区二区三区 | 91精品一区二区三区在线 | 伊人色综合久久天天人手人停 | 欧美性猛交xxxxxxxx软件 | 德国女人一级毛片免费 | 综合 欧美 国产 视频二区 | 男人操女人逼逼视频 |