⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mmwinfo.pas

📁 一套及时通讯的原码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{========================================================================}
{=                (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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -