熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

DELPHI基礎教程:開發Delphi對象式數據管理功能(五)[3]

2013-11-23 17:47:36  來源: Delphi編程 

  procedure TMainFormFileOpen(Sender: TObject)

  begin

  if OpenDialogExecute then

  begin

  DesignWin := TMDIChildCreate(Application)

  ReadComponentResFile(OpenDialogFileName DesignWin)

  DesignWinInit;

  FileName := OpenDialogFileName;

  DesignWinCaption := FFileName;

  end;

  end;

  DesignWin是在TMainForm中定義的TMDIChild類型的窗體部件是卡片設計平台FFileName是私有變量用來保存當前編輯的卡片文件名DesignWin的Init方法實現如下

  procedure TMDIChildInit;

  var

  I: Integer;

  Ctrl: TControl;

  begin

  BackGroundBringToFront;

  with BackGround do

  for I:= to ControlCount do

  if Controls[I]Name <> then

  ObjectInsObjectListItemsAddObject(Controls[I]Name Controls[I])

  end;

  BackGround是TPanel類型的部件所有的動態創建對象都插入到BackGround中所以後面調用BackGroundInsertControl(Ctrl)ObjectIns是個仿Delphi 的媒體屬性編輯器

  動態DFM文件的存儲過程是這樣的

  procedure TMainFormFileSave(Sender: TObject)

  begin

  if DesignWinCurControl <> nil then

  DesignWinCurControlEnabled := True;

  WriteComponentResFile(FFilename DesignWin)

  DesignWinCaption := FileName;

  end;

  end;

  因為在DesignWin的Init方法中調用了InsertControl方法所以在關閉DesignWin窗口時要相應地調用RemoveControl否則在關閉DesignWin窗口時會產生內存錯誤

  procedure TMDIChildFormCloseQuery(Sender: TObject; var CanClose: Boolean)

  var

  I: Integer;

  Ctrl: TControl;

  Removed: Boolean;

  begin

  if Modified = True then

  if MessageDlg(Close the form? mtConfirmation

  [mbOk mbCancel] ) = mrCancel then

  CanClose := False;

  if CanClose = True then

  begin

  repeat

  removed := False;

  I := ;

  repeat

  if BackGroundControls[I]Name <> then

  begin

  BackGroundRemoveControl(BackGroundControls[I])

  Removed := True;

  end;

  I := I +

  until (I >= BackGroundControlCount) or (Removed = True)

  until (Removed = False)

  SendMessage(ObjectInsHandle WM_MDICHILDCLOSED

  end;

  end;

   動態DFM文件應用之二超媒體系統腳本語言設計

  超媒體腳本語言設計是超媒體系統設計的重要內容腳本語言必須能夠表達卡片中的多種媒體對象必須是可編程可理解的必須是可執行的應該可以由腳本語言生成超媒體系統中的卡片和鏈

  DFM文件可以看作是超媒體系統的卡片DFM腳本能夠表達DFM文件中的多種控制也就是說能夠表達卡片中的多種媒體對象再加上DFM腳本的對象式表達可編輯性可轉換為DFM文件因此用作超媒體系統腳本語言較好的形式

  ObjectBinaryToText和ObjectTextToBinary過程提供了在部件和DFM腳本之間相互轉化的功能ObjectResourceToText和ObjectTextToResoure過程提供了DFM文件和DFM腳本之間相互轉化的功能這樣就可以在應用程序中自如實現超媒體卡片和超媒體腳本語言相互轉化

  下面是卡片和腳本語言相互轉化的程序

  procedure TMDIChildCardToScript;

  var

  In Out: TStream;

  begin

  In := TMemoryStreamCreate;

  Out := TMemoryStreamCreate;

  try

  InWriteComponentRes(SelfClassName Self)

  ObjectResourceToText(In out)

  ScriptFormScriptEditLinesLoadFromStream(Out)

  finally

  InFree;

  OutFree;

  end;

  end;

  ScriptEdit是個文本編輯器它的Lines屬性是TStrings類型的對象

  procedure TScriptFormScriptToCard;

  var

  In Out: TStream;

  begin

  In := TMemoryStreamCreate;

  Out := TMemoryStreamCreate;

  try

  ScriptFormScriptEditLinesSaveToFromStream(In)

  ObjectTextToResource(In out)

  InReadComponentRes(DesignWin)

  finally

  InFree;

  OutFree;

  end;

  end;

  這兩段程序是對整個卡片即窗體級進行轉換的ObjectBinaryToText和ObjectTextToBinary過程可以細化到部件級的轉換因此超媒體腳本語言的編輯可以細化到媒體對象級

   超媒體編輯和表現系統與動態DFM文件的擴展

  超媒體系統的媒體編輯與卡片管理有其特殊的需求比如鏈接需求這時采用已有的窗體部件和媒體部件並按常規的DFM文件處理就顯得力不從心了解決這個矛盾有兩套方案

  ● 利用Delphi部件開發技術繼承和開發新的部件增加新的超媒體特有的屬性和處理方法

  ● 擴展DFM文件結構使之能按自己的需要任意地存取和轉換部件和DFM文件

  前者是充分利用Delphi的面向對象部件開發技術在存取和轉換等處理上仍舊與常規DFM文件相同而後者需要DFM的存取和轉換上作比較大的改動下文介紹擴展DFM文件的思路

  擴展動態DFM文件的總體思路是降低處理操作的數據的顆粒度即從原先窗體級降低到部件級

  下面是存取操作的擴展示范

  var

  FileStream: TStream;

  I: Integer;

  begin

  FileStream := TFileStreamCreate(OverViewCrd fmOpenWrite)

  With TWriterCreate(FileStream ) do

  try

  for I := to DesignWinControlCount do

  begin

  WriteInteger(MMID[i])

  WriteRootComponent(DesignWinControls[i])

  { 寫相應媒體擴展信息 }

  ……

  end;

  WriteListEnd;

  finally

  Free;

  end;

  FileStreamFree;

  end;

  WriteInteger(MMID[i])語句是寫入媒體標識

  下面是相應的讀擴展DFM的程序

  var

  PropInfo: PPropInfo;

  Method : TMethod;

  FileStream: TStream;

  I: Integer;

  begin

  FileStream := TFileStreamCreate(OverViewCrd fmOpenRead)

  With TReaderCreate(FileStream ) do

  try

  while not EndOfList do

  begin

  case ReadInteger of

  IDText: begin

  Ctrl := TControl(ReadRootComponent(nil))

  PropInfo := GetPropInfo(CtrlClassInfo OnClick

  MethodCode:= SelfMethodAddress(MethodName)

  MethodData := Self;

  if MethodCode <> nil then

  SetMethodProp(Ctrl PropInfo Method)

  DesignWinInsertControl(Ctrl)

  end;

  IDImage:

  ……

  end;

  ……

  WriteListEnd;

  end;

  finally

  Free;

  end;

  FileStreamFree;

  end;

  SetMethodProp過程是用於重新聯接控制和它的事件處理過程類似的功能還可以用TReader對象的OnFindMethod事件的處理過程來實現

  實現腳本語言擴展的基本方法與存取擴展類似但它還要加擴展媒體信息轉換為文本並插入到部件的腳本描述中

   數據庫BLOB字段應用

  Delphi VCL提供了TBlobStream對象支持對數據庫BLOB字段的存取Delphi 的TBlobStream對象的作用在於一方面可以使Delphi應用程序充分利用多媒體數據庫的數據管理能力另一方面又能利用Delphi Object Pascal的程序設計能力給關系型多媒體數據庫提供底層控制能力和全方位的功能擴展余地

   TBlobStream的使用

  TBlobStream對象用一個TBlobField類型的對象作為參數來創建與BLOB字段相聯的BLOB流接著就可用流的存取方法在BLOB字段中存取數據

  var

  BlobStream: TBlobStream;

  I: Integer;

  begin

  BlobStream := TBlobStreamCreate(TBlobField(CardTableFields[] bmWrite)

  With TWriterCreate(BlobStream ) do

  try

  for I := to DesignWinControlCount do

  begin

  WriteInteger(MMID[i])

  WriteRootComponent(DesignWinControls[i])

  { 寫相應媒體擴展信息 }

  ……

  end;

  WriteListEnd;

  finally

  Free;

  end;

  BlobStreamFree;

  CardTablePost;

  end;

  Fields變量是表示數據庫記錄的字段數組Fields[]正是數據庫的BLOB 字段CardTable的Post方法將數據庫的修改反饋到數據庫的物理存儲上

  上面這段程序是超媒體卡片存儲的部分源程序我們就是將卡片保存在數據庫BLOB字段中實現將超文本和關系數據庫兩種數據管理方式結合起來讀卡片的程序如下

  var

  PropInfo: PPropInfo;

  Method: TMethod;

  Blobtream: TStream;

  I: Integer;

  begin

  BlobStream := TBlobStreamCreate(TBlobField(CardTableFields[]) bmRead)

  With TReaderCreate(BlobStream ) do

  try

  while not EndOfList do

  begin

  case ReadInteger of

  IDText: begin

  Ctrl := TControl(ReadRootComponent(nil))

  PropInfo := GetPropInfo(CtrlClassInfo OnClick

  MethodCode:= SelfMethodAddress(MethodName)

  MethodData := Self;

  if MethodCode <> nil then

  SetMethodProp(Ctrl PropInfo Method)

  DesignWinInsertControl(Ctrl)

  end;

  IDImage:

  ……

  end;

  ……

  WriteListEnd;

  end;

  finally

  Free;

  end;

  FileStreamFree;

  end;

   BLOB字段與圖形圖像

  在多媒體數據庫中處理得比較多的是圖形圖像因此早期的多媒體數據庫在擴展關系數據庫時往往是增加一個圖像字段BLOB字段是以二進制數據存儲方式因此它完全可以表達圖形圖像數據

  在TBlobField對象中提供了LoadFromBitMap和SaveToBitMap方法存取位圖數據它們在實現上都是使用BlobStream對象

  procedure TBlobFieldLoadFromBitmap(Bitmap: TBitmap)

  var

  BlobStream: TBlobStream;

  Header: TGraphicHeader;

  begin

  BlobStream := TBlobStreamCreate(Self bmWrite)

  try

  if (DataType = ftGraphic) or (DataType = ftTypedBinary) then

  begin

  HeaderCount := ;

  HeaderHType := $;

  HeaderSize := ;

  BlobStreamWrite(Header SizeOf(Header))

  BitmapSaveToStream(BlobStream)

  HeaderSize := BlobStreamPosition SizeOf(Header)

  BlobStreamPosition := ;

  BlobStreamWrite(Header SizeOf(Header))

  end else

  BitmapSaveToStream(BlobStream)

  finally

  BlobStreamFree;

  end;

  end;

  procedure TBlobFieldSaveToBitmap(Bitmap: TBitmap)

  var

  BlobStream: TBlobStream;

  Size: Longint;

  Header: TGraphicHeader;

  begin

  BlobStream := TBlobStreamCreate(Self bmRead)

  try

  Size := BlobStreamSize;

  if Size >= SizeOf(TGraphicHeader) then

  begin

  BlobStreamRead(Header SizeOf(Header))

  if (HeaderCount <> ) or (HeaderHType <> $) or

  (HeaderSize <> Size SizeOf(Header)) then

  BlobStreamPosition := ;

  end;

  BitmapLoadFromStream(BlobStream)

  finally

  BlobStreamFree;

  end;

  end;

  程序中按兩種方式存取數據對於位圖數據數據的起點是流的Potition為對於圖形或其它類型的Blob數據則以流的Position為SizeOf(Header) + 處開始 即多了個頭信息

[]  []  []  []  


From:http://tw.wingwit.com/Article/program/Delphi/201311/25090.html
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.