皆さん こんにちは らせん企画の佐々木です

  通信のログを表示するコンポーネントはないかという要望
に対するサンプルです。まだまだ早くできます。
  それと表示内容を TSrings に取っているのはログの保存も
兼ねるようにとの配慮からです。Property は自分で作ってく
ださい。



unit MsgPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

Type
  TScanLines = Array [0..65535] Of PByteArray;
  PScanLines = ^TScanLines;

  TMsgPanel = class(TCustomPanel)
  private
    { Private 宣言 }
    FMsgList: TStrings;
    FOutMap: TBitMap;
    FBMapRect: TRect;
    FLeftMargin, FTopMargin, FLineMargin,
    FLineHeight, FLineCount: Integer;

    FMsgCount: Integer;
    FLastMsg: String;

    Procedure BMapSizeSet;
    Function GetMsgCount: Integer;
    Function GetLastMsg: String;
    Procedure SetLeftMargin(pMargin: Integer);
    Procedure SetLineMargin(pMargin: Integer);
    Procedure SetTopMargin(pMargin: Integer);
    Procedure TextView;

    Property MsgCount: Integer Read GetMsgCount;
    Property LastMsg: String Read GetLastMsg;
  protected
    { Protected 宣言 }
    procedure Resize; Override;
  public
    { Public 宣言 }
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure Add(pMsg: String);
  published
    { Published 宣言 }
    Property Align;
    Property Font;
    Property MarginLeft: Integer Read FLeftMargin Write SetLeftMargin
                     Default 2;
    Property MarginLine: Integer Read FLineMargin Write SetLineMargin
                     Default 2;
    Property MarginTop: Integer Read FTopMargin Write SetTopMargin
                     Default 2;
  end;

procedure Register;

implementation

{ Create }
Constructor TMsgPanel.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  If csDesigning in ComponentState Then
    Self.Caption := '';
  FOutMap := TBitMap.Create;
  FMsgList := TStringList.Create;
  FLeftMargin := 2;
  FTopMargin := 2;
  FLineMargin := 2;
  Color := clWindow;
  BMapSizeSet;
End;

{ Destroy }
Destructor TMsgPanel.Destroy;
Begin
  FMsgList.Free;
  FOutMap.Free;
  Inherited;
End;

{ Add }
Procedure TMsgPanel.Add(pMsg: String);
Begin
  FMsgList.Add(pMsg);
  TextView;
End;

{ BMapSizeSet }
Procedure TMsgPanel.BMapSizeSet;
Var
  ixH: Integer;
  Procedure BMInit(pBM: TBitMap);
  Begin
    pBM.PixelFormat := pf1bit;
    pBM.Height := Self.Height;
    pBM.Width  := Self.Width;
    pBM.Canvas.Font.Assign(Self.Font);
    pBM.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
  End;
Begin
  BMInit(FOutMap);
  With FOutMap.Canvas Do
  Begin
    FLineHeight := TextHeight('Ag') + FLineMargin;
    FLineCount := Self.Height Div FLineHeight;
  End;
End;

{ GetMsgCount }
Function TMsgPanel.GetMsgCount: Integer;
Begin
  Result := FMsgList.Count;
End;

{ GetLastMsg }
Function TMsgPanel.GetLastMsg: String;
Begin
  Result := FMsgList[MsgCount - 1];
End;

{ Resize }
Procedure TMsgPanel.Resize;
Begin
  BMapSizeSet;
  TextView;
End;

{ SetLeftMargin }
Procedure TMsgPanel.SetLeftMargin(pMargin: Integer);
Begin
  If pMargin < 0 Then
    FLeftMargin := 0
  Else If pMargin > (Self.Width Div 2) Then
    FLeftMargin := Self.Width Div 2;
  TextView;
End;

{ SetLineMargin }
Procedure TMsgPanel.SetLineMargin(pMargin: Integer);
Begin
  If pMargin < 0 Then
    FLineMargin := 0
  Else If pMargin > (Self.Height Div 2) Then
    FLineMargin := Self.Height Div 2;
  TextView;
End;

{ SetTopMargin }
Procedure TMsgPanel.SetTopMargin(pMargin: Integer);
Begin
  If pMargin < 0 Then
    FTopMargin := 0
  Else If pMargin > (Self.Height Div 2) Then
    FTopMargin := Self.Height Div 2;
  TextView;
End;

{ TextView }
Procedure TMsgPanel.TextView;
Var
  ixW, ixH, wEnd, wLine: Integer;
Begin
  If MsgCount = 0 Then  Exit;
  wEnd := MsgCount - 1;
  wLine := FLineCount - 1;
  If FLineCount > MsgCount Then
    wLine := MsgCount - 1;
  If wLine >= FLineCount - 1 Then
  Begin
   FOutMap.Canvas.Draw(0, (FLineHeight * -1), FOutMap);
   FOutMap.Canvas.FillRect(Rect(0, FTopMargin + (wLine) * FLineHeight
                        , Self.Width, Self.Height));
  End;
  FOutMap.Canvas.TextOut(FLeftMargin
                       , FTopMargin + (wLine) * FLineHeight
                       , LastMsg);
  Self.Canvas.Draw(0, 0, FOutMap);
End;

procedure Register;
begin
  RegisterComponents('Samples', [TMsgPanel]);
end;

end.

             99/8/23(Mon) 04:32pm  BYQ05322 らせん企画の佐々木

Original document by らせん企画      氏 ID:(BYQ05322)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。