Delphi控件源码

开发平台：
Delphi

mmwinfo.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMWInfo;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    ExtCtrls,
    Buttons,
    MMObj,
    MMUtils,
    MMString,
    MMPanel,
    MMWave,
    MMRiff,
    MMDIB,
    MMCstDlg;
type
  {-- TMMRiffInfoEditorDlg ----------------------------------------------------}
  TMMRiffInfoEditorDlg = class(TForm)
    Bevel1: TBevel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ChunkInfoLabel: TLabel;
    INFOComboBox: TComboBox;
    GroupBox1: TGroupBox;
    InfoTextMemo: TMemo;
    RevertBtn: TButton;
    OKBtn: TButton;
    PictureBtn: TButton;
    Bevel3: TBevel;
    DescriptionEdit: TEdit;
    Label7: TLabel;
    Bevel2: TBevel;
    Label2: TLabel;
    DIBImage: TImage;
    PictureOpenDialog: TMMPictureOpenDialog;
    ClrBtn: TButton;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure INFOComboBoxChange(Sender: TObject);
    procedure InfoTextMemoExit(Sender: TObject);
    procedure RevertBtnClick(Sender: TObject);
    procedure DescriptionEditExit(Sender: TObject);
    procedure DescriptionEditKeyPress(Sender: TObject; var Key: Char);
    procedure DescriptionEditEnter(Sender: TObject);
    procedure PictureBtnClick(Sender: TObject);
    procedure ClrBtnClick(Sender: TObject);
  private
    lpInfo: PInfoChunk;
    lpDisp: PDispList;
    procedure SetupINFOComboBox(ItemIndex: integer);
    procedure SetupDISP;
    function  InfoChanged: Boolean;
  public
    procedure SetParams(Info: PInfoChunk; Disp: PDispList);
  end;
  {-- TMMRiffInfoEditor -------------------------------------------------------}
  TMMRiffInfoEditor = class(TMMNonVisualComponent)
  protected
    FSource: TObject;
    FTitle: String;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetParams(var Info: PInfoChunk; var Disp: PDispList); virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; virtual;
  published
    property Title: String read FTitle write FTitle;
  end;
  {-- TMMWaveInfoEditor -------------------------------------------------------}
  TMMWaveInfoEditor = class(TMMRiffInfoEditor)
  private
    function  GetSource: TMMCustomWaveFile;
    procedure SetSource(aSource: TMMCustomWaveFile);
  protected
    procedure GetParams(var Info: PInfoChunk; var Disp: PDispList); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Source: TMMCustomWaveFile read GetSource write SetSource;
  end;
var
  MMRiffInfoEditorDlg: TMMRiffInfoEditorDlg;
implementation
{$R *.DFM}
{== TMMRiffInfoEditorDlg ======================================================}
procedure TMMRiffInfoEditorDlg.SetParams(Info: PInfoChunk; Disp: PDispList);
begin
   if (Info <> lpInfo) then
   begin
      lpInfo := Info;
      SetupINFOComboBox(0);
   end;
   if (Disp <> lpDisp) then
   begin
      lpDisp := Disp;
      SetupDISP;
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.FormCreate(Sender: TObject);
begin
   INFOComboBox.Font.Handle := GetStockObject(ANSI_FIXED_FONT);
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.FormShow(Sender: TObject);
begin
   if (lpInfo <> Nil) then
   begin
      SetupINFOComboBox(0);
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.SetupDISP;
var
   pd: PDISP;
   lpDIB: PDIB;
   lpText: PChar;
   BM: HBitmap;
   Pal: HPalette;
   W,H: integer;
begin
   lpDIB := nil;
   lpText := nil;
   if (lpDisp <> nil) then
   begin
      pd := lpDisp^.pHead;
      while pd <> nil do
      begin
         if (pd^.cfid = CF_TEXT) and (lpText = nil) then
         begin
            { list contains Picture }
            if (pd^.lpData <> nil) then lpText := pd^.lpData
            else lpText := pd^.lpChunk;
         end;
         if (pd^.cfid = CF_DIB) and (lpDIB = nil) then
         begin
            { list contains Description }
            if (pd^.lpData <> nil) then
               lpDIB := PDIB(pd^.lpData)
            else if (pd^.wFlags <> CHUNK_MODIFIED) then
               lpDIB := PDIB(pd^.lpChunk);
         end;
         pd := pd^.pNext;
      end;
   end;
   if (lpText <> nil) then
       DescriptionEdit.Text := StrPas(lpText)
   else
       DescriptionEdit.Text := '';
   if (lpDIB <> nil) then
   begin
      ClrBtn.Enabled := True;
      DIB_DIBToBitmap(lpDIB,BM,Pal);
      if (DIB_Width(lpDIB) > DIBImage.Width) or
         (DIB_Height(lpDIB) > DIBImage.Height) then
         DIBImage.Stretch := True
      else
         DIBImage.Stretch := False;
      DIBImage.Picture.Bitmap.Handle := BM;
   end
   else
   begin
      ClrBtn.Enabled := False;
      DIBImage.Stretch := False;
      BM := LoadBitmap(HInstance, 'BMP_WAVE');
      GetBitmapSize(BM,W,H);
      DIBImage.Picture.Bitmap.Width := W;
      DIBImage.Picture.Bitmap.Height := H;
      DIBImage.Picture.Bitmap.Canvas.Brush.Color := Color;
      DIBImage.Picture.Bitmap.Canvas.FillRect(Rect(0,0,W,H));
      DrawTransparentBitmap(DIBImage.Picture.Bitmap.Canvas.Handle,BM,0,0,
                            GetTransparentColor(BM));
      DeleteObject(BM);
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.SetupINFOComboBox(ItemIndex: integer);
Const
   aFormat: PChar = '%-4s%-1s %-25s';
Var
   pi     : PInfoData;
   argList: array[0..5] of PChar;
   aBuf   : array[0..255] of Char;
begin
   if (lpInfo <> Nil) then
   begin
      INFOComboBox.Clear;
      pi := lpInfo^.pHead;
      {$IFDEF WIN32}
      {$IFDEF TRIAL}
      {$DEFINE _HACK1}
      {$I MMHACK.INC}
      {$ENDIF}
      {$ENDIF}
      while (pi <> Nil) do
      begin
         argList[0] := aINFO[pi^.index].pFOURCC;
         if ((pi^.dwINFOOffset<>0) and (PChar(lpInfo^.lpChunk+pI^.dwINFOOffset)^<>#0) and
            ((pi^.lpText=Nil)or(pi^.lpText^<>#0))) or
            ((pi^.lpText<>Nil)and(pi^.lpText^<>#0)) then
            argList[1] := '*'
         else
            argList[1] := ' ';
         argList[2] := aINFO[pi^.index].pShort;
         {$IFDEF WIN32}
	 wvsprintf(aBuf, aFormat, @argList);
         {$ELSE}
	 wvsprintf(aBuf, aFormat, argList);
         {$ENDIF}
         INFOComboBox.Items.Add(StrPas(aBuf));
	 pi := pi^.pnext;
      end;
      INFOComboBox.ItemIndex := ItemIndex;
      INFOComboBoxChange(Self);
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.INFOComboBoxChange(Sender: TObject);
var
   pi: PInfoData;
begin
   if (lpInfo <> Nil) then
   begin
      pi := lpInfo^.pHead;
      while (pi <> Nil) do
      begin
         if (pi^.index = INFOComboBox.ItemIndex) then break;
         pi := pi^.pNext;
      end;
      if (pi <> Nil) then
      begin
         if (pi^.lpText <> Nil) then
            { Modified text }
	    InfoTextMemo.Text := StrPas(pi^.lpText)
	 else if (pi^.dwINFOOffset > 0) then
	      { default text }
	      InfoTextMemo.Text := StrPas(lpInfo^.lpChunk+pi^.dwINFOOffset)
         else
	      { no text }
	      InfoTextMemo.Text := '';
         ChunkInfoLabel.Caption := StrPas(aINFO[INFOComboBox.ItemIndex].pLong);
      end
      else ChunkInfoLabel.Caption := 'Can''t FIND ItemIndex';
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.InfoTextMemoExit(Sender: TObject);
Var
   pi: PInfoData;
   pStr: PChar;
begin
   if (lpInfo <> Nil) then
   begin
      { get text out and give to current id }
      pi := lpInfo^.pHead;
      while (pi <> Nil) do
      begin
         if (pi^.index = INFOComboBox.ItemIndex) then break;
         pi := pi^.pnext;
      end;
      if (pi <> Nil) then
      begin
         pStr := GlobalAllocPtr(GHND, Length(InfoTextMemo.Text)+1);
         if (pStr <> Nil) then
         begin
            {$IFDEF WIN32}
            StrCopy(pStr, PChar(InfoTextMemo.Text));
            {$ELSE}
            StrPCopy(pStr, InfoTextMemo.Text);
            {$ENDIF}
            riffModifyINFO(lpInfo, pi, CHUNK_MODIFIED, 0, pStr);
            SetupINFOComboBox(INFOComboBox.ItemIndex);
         end;
      end
      else ChunkInfoLabel.Caption := 'Can''t FIND ItemIndex';
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.DescriptionEditKeyPress(Sender: TObject;
                                                       var Key: Char);
begin
   if (Key = #13) then DescriptionEditExit(Sender);
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.DescriptionEditEnter(Sender: TObject);
begin
   OKBtn.Default := False;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.DescriptionEditExit(Sender: TObject);
var
   pd: PDISP;
   lpText: PChar;
begin
   if (lpDisp <> nil) then
   begin
      pd := lpDisp^.pHead;
      while pd <> nil do
      begin
         if (pd^.cfid = CF_TEXT) then break;
         pd := pd^.pNext;
      end;
      lpText := GlobalAllocMem(Length(DescriptionEdit.Text)+1);
      {$IFDEF WIN32}
      StrCopy(lpText, Pchar(DescriptionEdit.Text));
      {$ELSE}
      StrPCopy(lpText, DescriptionEdit.Text);
      {$ENDIF}
      if (pd <> nil) then
      begin
         RiffModifyDISP(lpDisp, pd, CHUNK_MODIFIED, lpText);
      end
      else if (lpText^ <> #0) then
      begin
         pd := RiffCreateDISP(CHUNK_MODIFIED, CF_TEXT, nil, lpText);
         RiffInsertDISP(lpDisp,pd);
      end;
   end;
   if not DescriptionEdit.Focused then OKBtn.Default := True;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.PictureBtnClick(Sender: TObject);
var
   aPicture: TPicture;
   aBitmap : TBitmap;
   pd      : PDISP;
   lpDIB   : PDIB;
begin
   if PictureOpenDialog.Execute then
   begin
      {$IFDEF WIN32}
      {$IFDEF TRIAL}
      {$DEFINE _HACK1}
      {$I MMHACK.INC}
      {$ENDIF}
      {$ENDIF}
      aPicture := TPicture.Create;
      try
         aPicture.LoadFromFile(PictureOpenDialog.FileName);
         if (lpDisp <> nil) then
         with aPicture do
         begin
            aBitmap := TBitmap.Create;
            try
               if (Graphic is TBitmap) then
                  aBitmap.assign(Bitmap)
               else
               begin
                  aBitmap.Width := aPicture.Width;
                  aBitmap.Height := aPicture.Height;
                  aBitmap.Canvas.Brush.Color := Color;
                  aBitmap.Canvas.FillRect(Rect(0,0,aBitmap.Width,aBitmap.Height));
                  aBitmap.Canvas.Draw(0,0,Graphic);
               end;
               lpDIB := DIB_BitmapToDIB(aBitmap.Handle, aBitmap.Palette, BitsPerPixel, 1);
            finally
               aBitmap.Free;
            end;
            pd := lpDisp^.pHead;
            while pd <> nil do
            begin
               if (pd^.cfid = CF_DIB) then break;
               pd := pd^.pNext;
            end;
            if (pd <> nil) then
            begin
               RiffModifyDISP(lpDisp, pd, CHUNK_MODIFIED, PChar(lpDIB));
            end
            else
            begin
               pd := RiffCreateDISP(CHUNK_MODIFIED, CF_DIB, nil, PChar(lpDIB));
               RiffInsertDISP(lpDisp, pd);
            end;
            SetupDISP;
         end;
      finally
         aPicture.Free;
      end;
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.ClrBtnClick(Sender: TObject);
var
   pd: PDISP;
begin
   if (lpDisp <> nil) then
   begin
      pd := lpDisp^.pHead;
      while (pd <> nil) do
      begin
         if (pd^.cfid = CF_DIB) then break;
         pd := pd^.pNext;
      end;
      if (pd <> nil) then
      begin
         RiffModifyDISP(lpDisp, pd, CHUNK_MODIFIED, nil);
         SetupDISP;
      end;
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
procedure TMMRiffInfoEditorDlg.RevertBtnClick(Sender: TObject);
Var
   pi: PInfoData;
   pd: PDISP;
begin
   if (lpDisp <> Nil) then
   begin
      { reset all 'DISP' items to defaults read from file }
      pd := lpDisp^.pHead;
      while (pd <> Nil) do
      begin
         riffModifyDISP(lpDisp, pd, CHUNK_REVERT, Nil);
         pd := pd^.pnext;
      end;
      SetupDISP;
   end;
   if (lpInfo <> Nil) then
   begin
      { reset all 'INFO' items to defaults read from file }
      pi := lpInfo^.pHead;
      while (pi <> Nil) do
      begin
         riffModifyINFO(lpInfo, pi, CHUNK_REVERT, 0, Nil);
         pi := pi^.pnext;
      end;
      SetupINFOComboBox(INFOComboBox.ItemIndex);
   end;
end;
{-- TMMRiffInfoEditorDlg ------------------------------------------------------}
function TMMRiffInfoEditorDlg.InfoChanged: Boolean;
Var
   pi: PInfoData;
   pd: PDISP;
begin
   Result := False;
   if (lpDisp <> Nil) then
   begin
      { go trough all the 'DISP' items and look if modified }
      pd := lpDisp^.pHead;
      while (pd <> Nil) do
      begin
         if (pd^.wFlags = CHUNK_MODIFIED) then
         begin
            { yes modified data, exit }
            Result := True;
            exit;
         end;
         pd := pd^.pnext;
      end;
   end;
   if (lpInfo <> Nil) then
   begin
      { go trough all the 'INFO' items and look if modified }
      pi := lpInfo^.pHead;
      while (pi <> Nil) do
      begin
         if (pi^.wFlags = CHUNK_MODIFIED) then
         begin
            { yes modified text, exit }
            Result := True;
            exit;
         end;
         pi := pi^.pnext;
      end;
   end;
end;
{== TMMRiffInfoEditor =========================================================}
constructor TMMRiffInfoEditor.Create(AOwner: TComponent);
begin
   inherited create(AOwner);
   FTitle := 'Riff-Info Editor';
   FSource := nil;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMRiffInfoEditor ---------------------------------------------------------}
procedure TMMRiffInfoEditor.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent, Operation);
   if (Operation = opRemove) and (AComponent = FSource) then
      FSource := Nil;
end;
{-- TMMRiffInfoEditor ---------------------------------------------------------}
function TMMRiffInfoEditor.Execute: Boolean;
var
   Info: PInfoChunk;
   Disp: PDispList;
begin
   { Returns true if OK Button pressed and WaveInfo is changed }
   Result := False;
   if assigned(FSource) then
   begin
      with TMMRiffInfoEditorDlg.Create(Application) do
      try
         Caption := FTitle;
         GetParams(Info,Disp);
         SetParams(Info,Disp);
         Result := (ShowModal = mrOK) and InfoChanged;
      finally
         Free;
      end;
   end;
end;
{== TMMWaveInfoEditor =========================================================}
constructor TMMWaveInfoEditor.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Title := 'Wave-Info Editor';
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMWaveInfoEditor ---------------------------------------------------------}
procedure TMMWaveInfoEditor.GetParams(var Info: PInfoChunk; var Disp: PDispList);
var
   Wave: TMMWave;
begin
   Info := nil;
   Disp := nil;
   if assigned(FSource) and (FSource is TMMCustomWaveFile) then
   begin
      Wave := (FSource as TMMCustomWaveFile).Wave;
      if (Wave <> Nil) and not Wave.Empty then
      begin
         Info := Wave.PWaveIOInfo^.lpInfo;
         Disp := Wave.PWaveIOInfo^.lpDisp;
      end;
   end;
end;
{-- TMMWaveInfoEditor ---------------------------------------------------------}
function TMMWaveInfoEditor.GetSource: TMMCustomWaveFile;
begin
   Result := TMMCustomWaveFile(FSource);
end;
{-- TMMWaveInfoEditor ---------------------------------------------------------}
procedure TMMWaveInfoEditor.SetSource(aSource: TMMCustomWaveFile);
begin
   if Longint(aSource) = Longint(Self) then exit;
   if (aSource is TMMCustomWaveFile) or (aSource = Nil) then
   begin
      if (FSource <> aSource) then
      begin
         FSource := aSource;
      end;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
end.

						