teroll.pas

delphi2007界面效果控件源码

          else LightMap[Half+i  ] := aux;
        end;
      end;
    end
    else
    begin
      if RollPixels = 1
      then LightMap[1] := BaseLight
      else
      begin
        LightMap[1] := -BaseLight;
        LightMap[2] :=  BaseLight;
      end;
    end;
    LightMapSize := RollPixels;
  end;
end;

procedure ApplyLightMapHrz(LightMap: PteLightMap; Work, Src: PByteArray; k,
  RowLenght: Longint);
var
  Light: Byte;
  i,
  Limit: Longint;
begin
  i := 1;
  while k < 0 do
  begin
    Limit := k + RowLenght;
    Light := -LightMap[i];
    if LightMap[i] > 0
    then
    begin
      while k < Limit do
      begin
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k, 2);
      end;
    end
    else
    begin
      while k < Limit do
      begin
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k, 2);
      end;
    end;
    Inc(i);
  end;
end;

procedure ApplyLightMapVrt(LightMap: PteLightMap; Work, Src: PByteArray; k, l,
  RollRowLenght, RollGap, SrcGap: Longint);
var
  Light: Byte;
  i,
  Limit: Longint;
begin
  // Relative adjustment for using a single index
  SrcGap := SrcGap - RollGap;
  Src    := PByteArray(PChar(Src) + l - k);

  while k < 0 do
  begin
    i     := 1;
    Limit := k + RollRowLenght;
    while k < Limit do
    begin
      Light := -LightMap[i];

      if LightMap[i] > 0
      then
      begin
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Src[k] < Light
        then Work[k] := Src[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k, 2);
      end
      else
      begin
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Src[k] > Light
        then Work[k] := Src[k] - Light
        else Work[k] := 0;
        Inc(k, 2);
      end;
      Inc(i);
    end;
    Inc(k, RollGap);
    Src := PByteArray(PChar(Src) + SrcGap);
  end;
end;
{
procedure ApplyLightMapHrz(LightMap: PteLightMap; Work, Src: PByteArray; k,
  RowLenght: Longint);
var
  Light: Byte;
  i,
  Limit: Longint;
begin
  i := 1;
  while k < 0 do
  begin
    Limit := k + RowLenght;
    Light := -LightMap[i];
    if LightMap[i] > 0
    then
    begin
      while k < Limit do
      begin
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k, 2);
      end;
    end
    else
    begin
      while k < Limit do
      begin
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k, 2);
      end;
    end;
    Inc(i);
  end;
end;

procedure ApplyLightMapVrt(LightMap: PteLightMap; Work, Src: PByteArray; k, l,
  RollRowLenght, RollGap, SrcGap: Longint);
var
  Light: Byte;
  i,
  Limit: Longint;
begin
  while k < 0 do
  begin
    i     := 1;
    Limit := k + RollRowLenght;
    while k < Limit do
    begin
      Light := -LightMap[i];

      if LightMap[i] > 0
      then
      begin
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k);
        if Work[k] < Light
        then Work[k] := Work[k] + LightMap[i]
        else Work[k] := 255;
        Inc(k, 2);
      end
      else
      begin
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k);
        if Work[k] > Light
        then Work[k] := Work[k] - Light
        else Work[k] := 0;
        Inc(k, 2);
      end;
      Inc(i);
    end;
    Inc(k, RollGap);
  end;
end;
}

procedure TRollTransition.ApplyLightMap(LightMap: PteLightMap;
  Work, Src: PChar;
  Width, RollScanLineSize, SrcScanLineSize, FirstLightIndex: Longint;
  RollRect, UnUpdateRect, SrcRect: TRect);
var
  RollUpdParams,
  SrcUpdParams: TTEUpdParams;
  LM: PteLightMap;
begin
  GiveMeTheUpdParams(2, RollUpdParams, RollScanLineSize, RollRect, UnUpdateRect,
    pf32bit);
  GiveMeTheUpdParams(2, SrcUpdParams , SrcScanLineSize , SrcRect , UnUpdateRect,
    pf32bit);

  LM := PteLightMap(PChar(LightMap) + FirstLightIndex);
  if DirectionToUse in [tedDown, tedUp]
  then ApplyLightMapHrz(LM, PByteArray(Work - RollUpdParams.Start1),
         PByteArray(Src - SrcUpdParams.Start1),
         -RollUpdParams.Lenght1 * 4, RollUpdParams.RowLenght1 * 4)
  else ApplyLightMapVrt(LM, PByteArray(Work - RollUpdParams.Start1),
         PByteArray(Src - SrcUpdParams.Start1),
         -RollUpdParams.Lenght1 * 4, -SrcUpdParams.Lenght1 * 4,
         RollUpdParams.RowLenght1 * 4, RollUpdParams.Gap1 * 4,
         SrcUpdParams.Gap1 * 4);
end;

function TRollTransition.GetInfo(Device: TTETransitionDevice):
  TTETransitionInfo;
begin
  Result := inherited GetInfo(Device) +
    [
      tetiMillisecondsCapable,
      tetiOffScreenBmpCapable,
      tetiThreadSafe
    ];
end;

procedure TRollTransition.PaintRoll(Data: TTETransitionData; RollPixels, xAux,
  yAux: Integer);
var
  RollScanLineSize,
  SrcScanLineSize,
  FirstLightIndex: Integer;
  Work,
  Src: Pointer;
  RRollAux,
  RRollVis,
  RSrc: TRect;
  RollData: TRollData;
begin
  RollData := TRollData(Data.Custom);
  IntersectRect(RRollVis, RollData.RRoll, Rect(0, 0, Data.Width, Data.Height));
  RRollAux    := RRollVis;
  OffsetRect(RRollAux, -RollData.RRoll.Left, -RollData.RRoll.Top);
  RSrc.Left   := xAux + (RRollVis.Left - RollData.RRoll.Left);
  RSrc.Top    := yAux + (RRollVis.Top  - RollData.RRoll.Top);
  RSrc.Right  := RSrc.Left + (RRollVis.Right  - RRollVis.Left);
  RSrc.Bottom := RSrc.Top  + (RRollVis.Bottom - RRollVis.Top);
{
  BitBlt(RollBmp.Canvas.Handle, RRollAux.Left, RRollAux.Top,
    RRollAux.Right - RRollAux.Left, RRollAux.Bottom - RRollAux.Top,
    ReversedBmp.Canvas.Handle, RSrc.Left, RSrc.Top, cmSrcCopy);
}
  CreateLightMap(RollData.LightMap, RollData.LightMapSize, RollPixels);

  RollScanLineSize := GetBytesPerScanline(RollData.RollBmp    , pf32bit, 32);
  SrcScanLineSize  := GetBytesPerScanline(RollData.ReversedBmp, pf32bit, 32);
  Work             := PChar(RollData.RollBmp    .ScanLine[0]) + RollScanlineSize;
  Src              := PChar(RollData.ReversedBmp.ScanLine[0]) + SrcScanlineSize;

  if DirectionToUse in [tedRight, tedLeft]
  then FirstLightIndex := RRollAux.Left
  else FirstLightIndex := RollPixels - RRollAux.Bottom;

  ApplyLightMap(RollData.LightMap, Work, Src, RollData.RollBmp.Width,
    RollScanLineSize, SrcScanLineSize, FirstLightIndex, RRollAux,
    Rect(0, 0, 0, 0), RSrc);

  BitBlt(Data.Canvas.Handle, RRollVis.Left, RRollVis.Top,
    RRollVis.Right - RRollVis.Left, RRollVis.Bottom - RRollVis.Top,
    RollData.RollBmp.Canvas.Handle, RRollAux.Left, RRollAux.Top, cmSrcCopy);
end;

{ TRollData }

destructor TRollData.Destroy;
begin
  if TRollTransition(Data.Device.DelegateTransition).Is3D(Data.Device) then
    FreeMem(LightMap);

  ReversedBmp.Canvas.Unlock;
  ReversedBmp.Free;
  RollBmp    .Canvas.Unlock;
  RollBmp    .Free;

  inherited;
end;

initialization

  TERegisterTransition(TRollTransition);

end.